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I.  OBJECTIVE  AND  MOTIVATION 

Practical  engineering  application  can  often  be  formulated  in  the  form  of 
a constrained  optimization  problem.  There  are  several  solution  algorithms 
for  solving  a constrained  optimization  problem.  One  approach  is  to  convert  a 
constrained  problem  into  a series  of  unconstrained  problems.  Furthermore, 
unconstrained  solution  algorithms  can  be  used  as  part  of  the  constrained 
solution  algorithms.  Structural  optimization  is  an  iterative  process  where 
one  starts  with  an  initial  design,  a finite  element  structure  analysis  is 
then  performed  to  calculate  the  response  of  the  system  (such  as  displace- 
ments , stresses,  eigenvalues,  etc.).  Based  upon  the  sensitivity  information 
on  the  objective  and  constraint  functions,  an  optimizer  such  as  ADS  (Ref.  1) 
or  IDESIGN  (Ref.  2),  can  be  used  to  find  the  new,  improved  design.  The 
entire  process  can  be  summarized  in  Figure  1. 

From  Figure  1,  it  can  be  identified  that  a major  computational  effort 
occurs  in  the  structural  analysis  phase  to  find  the  static  solution,  the 
eigenvalue  solution,  and/or  the  dynamic  solution  of  the  governing  equations 
of  motion. 

For  the  structural  analysis  phase,  the  equation  solver  for  the  system  of 
simultaneous,  linear  equations  plays  a key  role  since  it  is  needed  for  either 
static,  or  eigenvalue,  or  dynamic  analysis.  The  equation  solver  is  also 
needed  for  the  sensitivity  analysis  and  optimization  phase. 

For  practical,  large-scale  structural  analysis -synthes is  applications, 
computational  time  can  be  excessively  large.  Thus,  it  is  necessary  to  have  a 
new  structural  analysis- synthesis  code  which  employs  new  solution  algorithms 
to  exploit  both  parallel  and  vector  capabilities  offered  by  modern,  high 
performance  computers  (available  at  NASA  Langley  Research  Center)  such  as  the 
Convex,  Cray -2  and  Cray-YMP  computers. 
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Figure  1.  A General  Flow  Chart  for  Structural  Optimization. 


2 


The  objectives  of  this  research  project  are,  therefore,  to  incorporate 
the  latest  development  in  the  parallel-vector  equation  solver,  PVSOLVE  (See 
Appendix  A)  into  the  widely  popular  finite-element  production  code,  such  as 
the  SAP-4  (See  Appendix  D)  . Furthermore,  several  nonlinear  unconstrained 
optimization  subroutines  have  also  been  developed  and  tested  under  a parallel 
computer  environment.  These  unconstrained  optimization  subroutines  are  not 
only  useful  in  their  own  right,  but  they  can  also  be  incorporated  into  a more 
popular  constrained  optimization  code,  such  as  ADS  (Ref.  1). 

II.  STRUCTURAL  ANALYSIS 

There  are  many  finite-element  based  structural  analysis  codes  available 
in  the  literature.  The  SAP-4  code  (See  Appendix  D)  has  been  selected  in  this 
research  project  due  to  the  following  four  main  reasons. 

1.  SAP -4  code  is  in  the  public  domain.  The  FORTRAN  source  code  is 
available  to  all  users  and  the  code  can  be  modified  to  incorporate 
new  numerical  algorithms. 

2.  SAP-4  code  has  a good  number  of  finite  element  libraries  and  has 
options  for  static,  eigenvalue,  and  dynamic  analysis. 

3.  Both  the  in-core,  and  out-of-core  solution  options  are  available  in 
SAP-4.  Thus,  large  scale  finite-element  models  can  be  handled  by 
the  code. 

4.  SAP-4  code  has  been  written  in  a modular  fashion,  thus  new  capa- 
bilities can  be  added  to  the  code  without  too  much  effort. 
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2.1  General  Description  of  SAP-4  Code 

SAP-4  is  a general  purpose,  finite-element  code  which  has  been  developed 
and  widely  used  in  the  industries,  government  laboratories,  and  academia  in 
the  1970's.  SAP-4  finite  element  library  includes: 

• Three-dimensional  truss  element 

• Three-dimensional  beam  element 

• Plane  stress,  plane  strain  and  axisymmetric  elements 

• Three-dimensional  solid  element 

• Thick  shell  element 

• Thin  plate  and  shell  element 

• Boundary  element 

• Pipe  element 

The  following  linear  finite  element  analysis  capabilities  of  SAP-4  are 
available 

• Static  analysis 

• Calculation  of  frequencies  and  mode  shapes 

• Dynamic  analysis 

For  a more  detailed  description  of  SAP-4  code,  a complete  SAP-4  manual 
is  given  in  Appendix  D. 

2.2  Modification  of  SAP-4  to  FV-SAP 
(Parallel-Vector  Structural  Analysis  Program) 

In  order  to  incorporate  the  newly  developed  Parallel -Vector  equation 
SOLVEr,  PV SOLVE  (See  Appendix  A)  into  the  SAP-4  code,  the  following  modifi- 
cations have  been  made  in  the  SAP-4  code: 

• Calculating  the  address  of  the  diagonal  terms  of  the  (one- 
dimensional)  coefficient  stiffness  matrix. 
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Assembling  the  global  coefficient  stiffness  matrix  in  a row- 
oriented,  variable  band  fashion. 

Solving  the  system  of  simultaneous  linear  equations  by  PVSOLVE. 

The  complete  listing  of  the  new  code,  PV-SAP,  is  given  in  APPENDIX 
E . 


2.3  Static  Application  of  PV-SAP  Code 
In  order  to  evaluate  the  performance  of  the  new  PV-SAP  code  as  compared 
to  the  original  SAP -4  code,  the  following  examples  have  been  considered. 

Example  1:  Two -Hundred  Bay,  Ten  Story  (2D)  Truss  Structure 

The  geometrical  pattern  as  well  as  the  load  of  this  structure  is  shown 
in  Figure  2.  Computational  time  (using  subroutine  timef)  for  the  new  PV-SAP 
code,  and  the  original  SAP-4  code  (using  the  Cray-2  super  computer  at  NASA 
Langley  Research  Center)  is  shown  in  Table  1.  A parallel  speed-up  factor  of 
3.59  (which  corresponds  to  a total  equation  solver  time  of  1.05  seconds)  was 
achieved  in  this  example  when  4 Cray-2  processors  were  used.  Furthermore, 
when  one  processor  was  used,  the  new  code  PV-SAP  used  only  3.76  seconds  as 
compared  to  15.47  seconds  from  the  original  SAP-4  code.  This  significant 
reduction  in  time  (even  for  one  processor)  is  due  to  the  fact  that  the  new 
equation  solver  (See  Appendix  A)  in  PV-SAP  has  utilized  the  loop-unrolling 
technique  for  better  vector  speed.  In  this  example,  PV-SAP  code  is  14.75 
times  faster  than  the  original  SAP-4  code. 

Example  2:  One  Hundred  Fifty  Bay.  Ten  Story  (2D)  Frame  Structure 

The  geometrical  pattern  and  the  load  of  this  structure  is  shown  in 
Figure  3.  Computational  time  (using  subroutine  timef)  for  the  new  PV-SAP 
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200  bays 


Figure  2:  Geometrical  Pattern  and  Loads  of  Example  1 


Figure  3:  Geometrical  Pattern  and  Loads  of  Example  2 
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Table  1.  Performance  of  PV-SAP  vs.  SAP-4  Code  on  Example  1. 


No.  of 
Processors 


Total  Equation 
Solver  Time 
(using  seconds) 


Speed 

Up 

(using  seconds) 


Total  Equation 
Solver  Time 
(using  timef) 


Speed  Up 
(using  timef) 


3.82 

(SAP-4  - 12.48) 
2.04 
1.49 
1.23 


1.00 


1.87 


2.56 


3.11 


3.762 

(SAP-4-15.469) 

1.945 

N/A 

1.049 


1.000 


1.934 


N/A 


3.586 


Table  2.  Performance  of  PV-SAP  vs.  SAP-4  Code  on  Example  2. 


No.  of 
Processors 

Total  Equation 
Solver  Time 
(using  seconds) 

Speed 

Up 

(using  seconds) 

Total  Equation 
Solver  Time 
(using  timef) 

Speed  Up 
(using  timef) 

1 

5.24 

(SAP-4  - 16.47) 

1.00 

5.123 

(SAP-4-15.469) 

1.00 

2 

2.86 

1.83 

2.657 

1.928 

3 

2.02 

2.59 

N/A 

N/A 

4 

1.81 

2.90 

1.414 

3.623 

code,  and  the  original  SAP-4  code  (using  the  Cray- 2 supercomputer  at  NASA 
Langley  Research  Center)  is  shown  in  Table  2.  In  this  example,  PV-SAP  code 
is  10.94  times  faster  than  the  original  SAP-4  code. 

Example  3:  Two  Hundred  Eighty  Bay,  Five  Storv  (2D)  Frame  Structure 

The  geometrical  pattern  and  the  load  of  this  structure  is  the  same  as 
shown  in  Figure  3,  except  for  the  number  of  bays  and  the  number  of  stories. 

Computational  time  (using  subroutine  timef)  for  the  new  PV-SAP  code,  and 
the  original  SAP -4  code  (using  the  Cray -2  super  computer  at  NASA  Langley 
Research  Center)  is  shown  in  Table  3.  In  this  example,  PV-SAP  code  is  15.65 
times  faster  than  the  original  SAP-4  code. 

III.  STRUCTURAL  OPTIMIZATION 

The  purpose  of  Design  Optimization  is  searching  for  the  best  solution 
with  a limited  resource.  In  many  engineering  applications,  design  optimi- 
zation starts  with  formulating  the  problem  and  follows  by  solving  it  using  a 
mathematical  programming  technique.  The  general  formulation  of  a design 
optimization  problem  is  given  as 


min  f(b,x) 
bcRn 

subject  to 

gi(b,x)  < 0,  j - 1,  . . .m 
hk(b,x)  - 0,  k - 1,  . . .1  (3.3) 

bil  < bi  < biu*  i ” 1.  •••n  (3.4) 


(3.1) 


(3.2) 
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Table  3.  Performance  of  PV-SAP  vs.  SAP-4  Code  on  Example  3. 


No.  of 
Processors 

Total  Equation 
Solver  Time 
(using  seconds) 

Speed 

Up 

(using  seconds) 

Total  Equation 
Solver  Time 
(using  timef) 

Speed  Up 
(using  timef) 

1 

1.00 

13.684 

(SAP-4-58.592) 

1.000 

2 

7.24 

1.96 

6.995 

1.956 

3 

5.31 

2.67 

N/A 

N/A 

4 

4.62 

3.07 

3.743 

3.660 
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where  b and  x are  the  design  and  state  variables,  respectively.  Furthermore, 
the  equality  constraints  hk(b,x)  - 0,  may  include  state  equations  that  yield 
the  solution  of  state  variables. 

The  above  design  optimization  problem  is  generally  nonlinear  and  it  can 
only  be  solved  numerically.  One  class  of  numerical  schemes  is  called  the 
direct  search  technique,  which  iteratively  looks  for  a better  design  in  the 
design  space  and  stops  only  when  certain  convergence  criteria  are  satisfied. 
In  other  words,  in  each  iteration,  the  technique  finds  a better  design  as 

xnew  " xold  + (3.5) 

where  a is  a scalar  quantity  defined  as  the  step  size  and  P is  a vector 
defining  a search  direction  to  improve  the  solution.  Usually,  the  search 
direction,  P,  is  the  solution  of  a subproblem  which  is  obtained  by  linear- 
izing the  optimal  design  problem,  Eqs.  (3.1) -(3. 4).  The  subproblem  can  be 
either  unconstrained  or  constrained. 

The  software  package,  Automated  Design  Synthesis,  or  ADS  (Ref.  1),  can 
be  a good  candidate  for  solution  of  the  optimal  design  problem.  ADS  is  a 
general-purpose  optimization  package  that  offers  various  algorithms  to  find 
the  optimal  solution.  An  ADS  user  can  select  one  of  the  nine  strategy 
options  to  formulate  a subproblem  which  subsequently  can  be  solved  by  one  of 
the  five  optimizers,  depending  upon  the  formulation  of  the  subproblem.  Among 
the  five  optimizers,  Fletcher-Reeves  algorithm,  Davidon- Fletcher -Powell  and 
Braydon-Fletcher-Goldfarb-Shanno  variable  metric  methods  are  used  for 
unconstrained  subproblems  and  two  versions  of  feasible  direction  methods  for 
constrained  subproblems. 
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Once  the  search  direction,  P,  is  found,  a proper  step  size,  a,  in  Eq. 
(3.5)  is  computed  in  order  to  completely  define  the  new  design  xnew.  The 
best  a is  determined  in  such  a way  that  the  new  design  can  reduce  the 
objective,  as  well  as  correct  the  constraint  violations.  Determination  of  a 
proper  a is  usually  the  most  time  consuming  process  in  a design  optimization 
algorithm,  because  it  requires  many  function  analyses.  To  determine  a,  ADS 
provides  eight  different  one -dimensional  search  algorithms,  among  which  five 
find  the  minimum  of  an  unconstrained  function  and  three  find  the  minimum  of  a 
constrained  function. 

It  should  be  noted  that  an  ADS  user  should  select  a design  optimization 
algorithm  which  is  consistent  with  the  strategy  options,  the  optimizers  and 
the  one -dimensional  search  algorithms.  That  is,  for  example,  an  optimizer 
for  an  unconstrained  problem  should  be  selected  in  ADS  if  an  unconstrained 
subproblem  is  formulated  by  the  strategy  option  selected. 

The  ADS  is  a collection  of  subroutines.  The  ADS  can  be  invoked  by 
calling  the  subroutine  ADS,  as  follows:  Call  ADS  (INFO,  ISTRAT,  IOPT,  IONED, 

IPRINT,  IGRAD , NDV,  NCON,  X,  VLB,  VUB,  OBJ,  G,  IDG,  NGT , IC,  DF,  A,  NRA, 
NCOLA,  WK,  NRWK,  IWK,  NRIWK) , where  the  integer  parameters,  ISTRAT,  IOPT, 
IONED  and  IPRINT  are  defined  as: 

ISTRAT:  Optimization  strategy  to  be  used. 

IOPT:  Optimization  to  be  used. 

IONED:  One -dimensional  search  algorithm  to  be  used. 

IPRINT:  A four-digit  print  control. 

An  ADS  user  has  the  option  to  either  require  ADS  to  calculate  function 
gradients  using  the  finite  difference  method  or  to  provide  function  gradients 
himself.  The  user  should  use  the  arrays  DF  and  A in  subroutine  ADS  to  store 
the  gradient  information.  Furthermore,  since  the  active  constraint  strategy 
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is  employed  in  ADS,  the  user  should  only  provide  the  gradients  of  constraints 
that  are  active.  The  active  constraints  can  be  identified  by  the  array  IC. 
Application  examples  are  given  in  the  ADS  manual  to  demonstrate  how  to  use 
the  ADS  software  package.  Other  important  aspects  such  as  restarting  the 
code  and  redefining  control  parameters  in  ADS  are  also  detailed  in  the  ADS 
manual . 


3.1  Parallel  Golden  Block  Search  Technique 
In  this  research  work,  a parallel  version  of  the  Golden  Block  Search 
technique  has  been  developed  for  determining  the  step  size  a in  Eq.  (3.5). 
Theoretical  development  of  the  Golden  Block  Search  technique  [3]  is 
summarized  in  the  following  paragraphs; 

• The  Golden  Section  method  is  based  on  the  Fibonacci  sequence,  which 
is  defined  as 


Fi  “ 1 


F - F _ + F 
n n- 1 n- 2 

where  n - 2 , 3 ,4  . 


with  the  properties 


- r - I (1  + V~5~ ) « 1.618  - golden  ratio 
2 

n -*•  <*> 

The  Fibonacci  Sequence  is  a special  case  of  the  Arriel  Sequence 


where  n * 2 , 3 ,4 
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Thus,  when  k - 1,  then  the  Arriel  Sequence  will  become  the 
Fibonacci  Sequence 


In  order  to  apply  the  Arriel  Sequence  to  modify  the  Golden  Search 
technique,  we  assume: 


. n+2  An+1 

\ _ \ 

An+1  An 


t.  as 
k 


n -►  oo 


(3.7) 


and  try  to  derive  the  condition  for  which  (refer  to  Eq.  3.7) 
needs  to  be  satisfied. 

Derivation  of  a formula  for 


Solving  the  quadratic  Eq.  (3.10)  and  using  only  the  positive  root, 
one  has : 


T 


k 


fmm 

“\  / 2 

(k  + y k +4k) 


NOTE:  If  k - 1,  then  r. 

k 


(3.11) 


— (1  + 5)  - 1.618  - the  standard 

2 


golden  section  ratio 


The  above  Golden  Block  Search  Algorithm  can  be  conveniently  presented  in 
a form  of  a step-by-step  algorithm  (also  refer  to  Figure  4). 

Step  1:  d^  - b - a 

D 

Step  2:  First  block  search  (for  i - 1) 


- a 


- a + (— ) d^  where  r - i (k  +~\f  k^+4k) 

1 D K 0 v 

'k  2 


- <*j_2  + (i_)  dg  where  j - 2,3 2k 


parallel  computation  for  F (aj ) 


where  j -0,1, 2,3,  2k 


Step  3:  Find  the  value  of  a which  gives  the  minimum  value  of  F,  say 


1 1 
-Qi 
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Figure  4:  Golden  Block  Search  Algorithm 
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Step  4:  Set  ^ and  ^ - a*+1 


Thus  dfi  - R1-r1 


Step  5:  Subsequent  i*-*1  block  search  (for  i > 2) 


a0  ” ri-l 


i ^ .1  Ni  . 0 

“1  “ ri-l  + <“>  dB 

Tk 


“j  " “j-2  + (— } * <rk)l  i Where  j _ 2,3 2k 


compute  F(cXj) 

Step  6:  Return  to  step  3 if  the  process  does  not  converge 

Based  upon  the  above  step-by-step  procedure,  the  parallel  golden  block 
search  algorithm  has  been  developed,  and  the  complete  listing  of  this  sub- 
routine is  given  in  Appendix  B. 


Le  Example  on  Golden  Block  Search  Method 


Min  F(x)  - 2.0  + e - 4x 


use  k - 4,  thus,  according  to  Eq.  (3.11),  one  has 


rk  - t (4  + Y 16  + 16)  - 4.8284271 
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Table  4 indicates  that  the  Golden  Block  Search  method  converges  in  five 


iterations . 


An  Example  for  Parallel  Golden  Block  Search  Method 
Find  t which  minimizes  the  function 

t2  t4  t6  tn 

F(t)  - cos(t)  -1  - — + — - — + + — + 


(3.12) 


2! 


4! 


6! 


n! 


The  optimum  solution  is  t — t*  — n and  F — F*  — -1.0. 

The  following  symbols  are  used  in  Table  5: 

NP  - number  of  processors  used 

k - the  coefficient  given  in  Eq.  (3.11) 

n - number  of  terms  used  in  Eq.  (3.12) 

S - speed  up  factor 

rj  - efficiency 

c - convergence  tolerance 

The  performance  of  the  Parallel  Golden  Block  Search  algorithm  is  shown 
in  Table  5 . 


3.2  Parallel -Vector  BFGS  Method 

In  these  methods,  the  Hessian  rather  than  its  inverse  is  updated  at 
every  iteration.  We  shall  present  a method  that  is  most  popular  and  has 
proved  to  be  most  effective  in  applications.  Detailed  derivation  of  the 
method  is  given  in  Gill  et  al.  (also  see  Reference  2).  It  is  known  as  the 
BFGS  (Broyden- Fie tcher - Goldf arb - Shanno ) method  described  as  follows. 

Step  1:  Estimate  an  initial  design  . Choose  a symmetric  positive 

definite  matrix  h(°)  as  an  estimate  for  the  Hessian  of  the  cost  function.  In 
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Table  4.  Sequential  Golden  Block  Search  Example. 
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Table  5.  Parallel  Golden  Block  Search  Example. 


n - 600,  e - 1.0  x 10'9 


k - 1 


NP 

Time  (Seconds) 

s 

ft  (%) 

i 

0.3553 

1 

100. 

k - 2 

i 

0.3381 

1 

100. 

k - : 

5 

i 

-| 

0.3866 

1 

100. 

2 

0.2008 

1.925 

96.25 

3 

0.13668 

2.83 

94.30 

4 

0.12797 

3.02 

75.60 

k - 5 


1 

0.48918 

1 

100 

2 

0.25147 

1.95 

97.3 

3 

0.19397 

2.52 

84.10 

4 

0.14565 

3.36 

84.0 

k - 6 


1 

0.54002  [ 

1.0 

100 

2 

0.27735 

1.95 

97.4 

3 

0.18711 

2.89 

96.2 

4 

0.14365 

3.76 

94.0 

k - 7 


1 

0.57734 

1.0 

100 

2 

0.29258 

1.973 

98.7 

3 

0.20595 

2.8033 

93.4 

4 

0.16478 

3.504 

87.6 
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the  absence  of  more  information,  let  H^)  - I.  Choose  a convergence 
parameter  e.  Set  k — 0,  and  compute  the  gradient  vector  as 

c(0)  - Vf(b(^))  where  f is  an  objective  function. 

Step  2:  Calculate  the  norm  of  the  gradient  vector  as  ||c(k)||.  if 

||c00||  < € then  stop  the  iterative  process;  otherwise  continue. 

Step  3:  Solve  the  following  linear  system  of  equations  to  obtain  the 

search  direction: 

HOOp(k)  - -c<k) 

Compute  optimum  step  size  ak  - a to  minimize  f(b^k)  + ap(k)). 
Update  the  design  as 

b(k+l)  - b(k>  + akp<k> 

Step  6:  Update  the  Hessian  approximation  for  the  cost  function  as 

H(k+1)  _ H(k)  + D(k)  + E(k) 

where  the  correction  matrices  D^k)  and  E(k)  are  given  as 


Step  4: 
Step  5: 


...  (k)  (k) 

D00_  y y 


(yW.  .00) 


,00 


„<k)  (k) 
c c 


(c 


(k) 


p<k>) 
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with  sOO  - a^pW  (change  in  design) 

y(k)  - c(k+l)  - c(k)  change  in  gradient) 
c(k+l)  _ vf(b(k+1)) 

Step  7:  Set  k - k + 1 and  go  to  Step  2. 

Notice  that  the  first  iteration  of  the  method  is  the  same  as  that  for 
the  steepest  descent  method. 

It  can  be  shown  that  the  BFGS  update  formula  keeps  the  Hessian  approxi 
mation  positive  definite  if  exact  line  search  is  used.  This  is  important  to 
know  as  the  search  direction  is  guaranteed  to  be  that  of  descent  for  the  cost 
function  only  if  H<k)  is  positive  definite.  In  numerical  calculation,  diffi- 
culties can  arise  because  Hessian  can  become  singular  or  indefinite  due  to 
inexact  line  search  and  round-off  and  truncation  errors.  Therefore,  some 
safeguards  against  the  numerical  difficulties  must  be  implemented  into 
computer  programs  for  stable  and  convergent  calculations.  Another  numerical 
procedure  that  is  extremely  useful  is  to  update  decomposed  factors  (Cholesky 
factors)  of  the  Hessian  rather  than  the  Hessian  itself.  This  way  the  matrix 
can  be  numerically  guaranteed  to  be  positive  definite. 

In  this  project,  parallel -vector  implementation  of  the  BFGS  method  has 
been  achieved  by  incorporating  the  mixture  of  both  the  direct  parallel-vector 
equation  solver  (see  Appendix  A)  and  the  iterative  parallel-vector  equation 
solver  into  Step  3 of  the  above  BFGS  process.  The  complete  listing  of  the 
parallel  BFGS  code  is  given  in  Appendix  C.  Table  6 summarizes  the 
performance  of  the  BFGS  in  a parallel  computer  environment.  In  Table  6, 
systems  of  200  and  300  coupled,  nonlinear  equations  have  been  formulated  as 
the  nonlinear,  unconstrained  optimization  problems  and  were  solved  by  the 
parallel -vector  BFGS  method. 
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IV.  CONCLUSIONS  AND  FUTURE  RESEARCH 


The  fast  parallel -vector  equation  solver  (See  Appendix  A)  has  been 
incorporated  into  a well-known  SAP-4  finite  element  structural  analysis  code. 
The  new  code,  PV-SAP,  has  been  tested  for  static  applications.  Initial 
results  have  indicated  that  the  new  code,  PV-SAP  is  10.94  to  15.65  times 
faster  than  the  original  SAP-4  code  when  4 Cray-2  (at  NASA  Langley  Research 
Center)  processors  were  used. 

For  the  one -dimensional  line  search  problem,  the  parallel  Golden  Block 
Search  method  has  been  developed.  For  a simple  tested  problem,  a speed-up 
factor  of  3.76  was  obtained  when  4 Cray- 2 processors  were  used. 

For  the  nonlinear  unconstrained  optimization  problem,  the  parallel- 
vector  version  of  the  BFGS  method  has  been  developed.  Initial  results  have 
indicated  that  a speed-up  factor  of  3.21  was  obtained  when  4 Cray- 2 
processors  were  used. 

Practical  structural  optimization  problems  can  usually  be  formulated  in 
the  form  of  a nonlinear  constrained  optimization  problems.  All  the  results 
obtained  from  this  research  work,  however,  can  be  directly  used  for  the  next 
phase  of  this  project.  The  remaining  task  which  needs  to  be  done  is  to 
provide  the  sensitivity  information  for  PV-SAP  since  this  sensitivity 
information  is  needed  for  many  existing  optimization  packages , such  as  the 
ADS  in  Ref.  1. 
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Abstract 

A fast,  accurate  Choleski  method  for  the  solution  of 
symmetric  systems  of  linear  equations  is  presented.  This 
direct  method  is  based  on  a variable-band  storage  scheme  and 
takes  advantage  of  column  heights  to  reduce  the  number  of 
operations  in  the  Choleski  factorization.  The  method 
employs  parallel  computation  in  the  outermost  DO-loop  and 
vector  computation  via  the  "loop  unrolling"  technique  in  the 
innermost  DO- loop.  The  method  avoids  computations  with 
zeros  outside  the  column  heights,  and  as  an  option,  zeros 
inside  the  band.  The  close  relationship  between  Choleski 
and  Gauss  elimination  methods  is  examined.  The  minor 
changes  required  to  convert  the  Choleski  code  to  a Gauss 
code  to  solve  non-positive-definite  symmetric  systems  of 
equations  are  identified.  The  results  for  two  large-scale 
structural  analyses  performed  on  supercomputers, 
demonstrate  the  accuracy  and  speed  of  the  method. 


Nomenclature 


ea 

error  norm  for  solution  residuals 

es 

strain  energy  error  norm 

(fl 

load  vector 

hpm 

hardware  performance  monitor  (Cray) 

UJc 

DO  loop  indices 

ja 

job  accounting  utility  (Cray) 

pq 

stiffness  matrix 

MFLOPS 

Million  FLoating  point  OPerations/Second 

mij 

multipliers  for  forward  substitution 

n 

number  of  equations 

NP 

number  of  processors 

(R) 

error  residual  for  solution:  [K]  (x)  - (f) 

RAM 

Random  Access  Memory 

SAXPY 

£ ax  + y,  or  scalar  * vector  + vector 

second 

CPU  time  function  (Cray) 

SRB  space  shuttle  Solid  Rocket  Booster 

timef  elapsed  time  function  (Cray) 

[U]  upper  triangular,  factored  stiffness  matrix 

uy  terms  of  upper-triangular  matrix 

{x}  static  structural  displacements 


1.  Introduction 

Since  the  invention  of  the  first  electronic  computer  by 
Atanasoff  to  solve  matrix  equations  of  order  29  in  1939  ^ . 
researchers  in  many  scientific  and  engineering  disciplines 
have  found  their  problems  invariably  reduced  to  solving 
systems  of  simultaneous  equations  that  simulate  and  predict 
physical  behavior.  Currently,  the  solution  of  linear  systems 
of  equations  on  advanced  parallel- vector  computers  is  a key 
area  of  research  with  applications  in  many  disciplines*’**. 
Structural  analysis  codes  in  wide  use  today  were  developed 
on  single  processor  computers  and  often  do  not  fully  exploit 
the  vector  or  parallel  processing  capability  of  modem  high- 
performance  computers.  To  achieve  a high  level  of 
efficiency  on  parallel-vector  supercomputers,  a restructuring 
of  the  equation  solution  procedure  and  the  memory  and  data 
management  of  these  structural  analysis  codes  is  required. 
For  example,  the  skyline  storage  technique  used  in  many 
sequential  structural  analysis  codes  lacks  the  efficiency  of 
other  storage  techniques  used  in  the  solution  of  linear 
systems  of  equations  on  vector  computers7*8.  Of  equal 
importance,  several  parallel  equation  solvers  have  been 
demonstrated  to  work  well  for  static  and  dynamic  structural 
analyses,  eigenvalue  and  buckling  analyses,  sensitivity 
analysis  and  structural  optimization9*1^.  Since  high- 
performance  computers  currently  have  both  parallel  and 
vector  capability,  the  algorithms  that  exploit  both  will 
achieve  optimal  performance  for  these  computers. 
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Based  on  favorable  experience  on  sequential  computers,  a 
parallel-vector  Choleski  algorithm  using  a skyline  storage 
scheme  was  developed  and  shown  to  have  excellent  parallel 
performance  on  a Cray  2 supercomputer  as  the  number  of 
processors  increased16.  However,  the  skyline  scheme  was 
found  to  prohibit  the  traditional  loop  unrolling  technique 
used  to  optimize  vector  performance,  so  a less  powerful 
"vector  unrolling"  strategy  was  used. 

The  present  paper  describes  a new  algorithm  that  overcomes 
the  deficiency  of  skyline  storage  by  using  a variable- band 
storage  scheme.  The  objective  of  this  paper  is  to  describe 
this  new  algorithm  for  solving  matrix  equations  and  to 
demonstrate  its  accuracy  and  speed  by  solving  large-scale 
structural  analysis  applications  on  Cray  supercomputers. 

Since  equation  solution  algorithms  depend  on  the  storage 
scheme  selected,  two  of  the  storage  schemes  used  most 
often  are  discussed  in  Section  2 of  the  present  paper.  A 
description  of  how  the  basic  Choleski  method  was 
implemented  to  achieve  both  vector  and  parallel  speed  is 
discussed  in  Section  3.  The  parallel  FORTRAN  language, 
Force1^,  used  to  implement  this  method,  is  also  discussed 
in  Section  3.  The  results  obtained  for  two  large-scale 
structural  analysis  problems  to  evaluate  the  performance  of 
the  algorithm  are  discussed  in  Section  4.  The  minor 
changes  required  to  convert  this  newly-developed  code  from  a 
Choleski  algorithm  to  a Gauss  algorithm  for  solving  non- 
posilive-definite  symmetric  systems  of  equations  are 
identified  with  examples  in  Appendix  A.  A description  of 
the  input  data  with  a simple  example  is  in  Appendix  B.  A 
listing  of  the  code  and  its  use,  both  in  a stand-alone  mode 
and  in  the  CSM  Testbed18,  is  described  in  Appendix  C. 


2.  Data  Storage  Schemes 

The  Choleski  method  for  the  solution  of  simultaneous 
equations  requires  the  decomposition  of  the  matrix  of 
stiffness  coefficients,  [K],  into  an  upper-triangular,  factored 
stiffness  matrix,  [U],  Details  of  this  matrix  decomposition 
are  given  in  Section  3 and  Appendix  A.  Two  methods  most 
often  used  in  structural  analysis  codes  to  store  [TJ]  are  the 
variable-band,  and  skyline  techniques. 

For  large  finite-element  applications,  the  user  defines  the 
geometry,  finite  elements  and  loads  of  the  finite-element 
model.  The  user  may  use  automated  algorithms  to  reorder 
the  resulting  stiffness  matrix,  [K],  in  the  form  that  is  most 
efficient  for  the  solver.  The  reverse  Cuthill-McKee 

algorithm19  reorders  the  [K]  matrix  into  a near  minimum 
bandwidth,  and  thus  is  used  for  the  examples  in  this  paper. 

In  a row-oriented,  variable-bandwidth  Choleski  approach,  the 
bandwidth  of  each  row  of  the  upper-triangular  matrix,  [U],  is 
defined  as  the  number  of  coefficients  from  a diagonal  term  to 
the  last  non-zero  coefficient  of  the  row,  excluding  the 
diagonal  term.  The  coefficients  of  the  stiffness  matrix  for  a 
stiffened  panel  with  a circular  cutout  (bottom  of  Fig.  1),  are 
plotted  in  a variable-band  format  as  shown  in  Fig.  1. 


Fig,  1 Variable-band  row  storage  of  panel  matrix. 

The  coefficients  of  the  matrix  are  stored  by  rows  where  each 
row  represents  a degree  of  freedom  in  the  finite-element 
model.  The  variable-band  storage  includes  all  zero 
coefficients  within  the  so  called  "profile"  which  is  defined  by 
the  ragged  right  edge  of  the  matrix  represented  in  Fig.  1. 
Variable-band  storage  requires  less  memory  than  earlier 
schemes  which  stored  all  coefficients  within  the  maximum 
bandwidth,  since  earlier  schemes  stored  and  operated  on 
many  zeros  outside  the  variable-band  profile. 


The  same  panel  stiffness  matrix  is  stored  by  columns  in  the 
skyline  format,  like  skyscrapers,  in  Fig.  2 from  each 
diagonal  coefficient  up  to  the  last  nonzero  directly  above  it. 


Fig.  2 Skyline  column  storage  of  panel  matrix. 


In  this  column-oriented  storage  scheme,  the  column  height 
is  defined  as  me  number  of  coefficients  from  a diagonal 
coefficient  to  the  last  nonzero  coefficient  in  the  same 
column,  excluding  the  diagonal  coefficient,  as  shown  in  Fig. 
2.  This  skyline  format  requires  fewer  coefficients  to  store 
and  operate  on  during  equation  solution  as  indicated  by  the 
many  zeros  (white  spaces)  in  Fig.  2.  The  panel  example  is 
used  for  illustrative  purposes  only,  as  in  many  applications, 
the  reduction  in  storage  offered  by  the  skyline  approach  is 
not  so  pronounced. 

Factorization  of  a matrix  using  skyline  storage  has  the 
advantage  that  calculations  with  zeros  outside  the  skyline 
need  not  be  performed  since  zeros  remain  in  these  locations 
after  factorization.  Although  the  skyline  method  has  the 
advantage  of  minimizing  the  storage  and  number  of 
operations  required  on  sequential  computers,  it  cannot 
achieve  optimal  vector  speed  on  high-performance  computers 
since  it  cannot  use  efficient  SAXPY  operations  (i.e.,  Z ax  + 
y,  or  scalar  * vector  + vector).  SAXPY  operations  achieve 
optimal  performance  on  vector  computers  since  they 
continually  stream  operations  to  separate  add  and  multiply 
units  which  can  operate  simultaneously. 

To  compare  the  storage  schemes  in  detail,  the  location  of  the 
coefficients  in  the  upper  half  of  a 9x9  symmetric  stiffness 
matrix  are  shown  in  Fig.  3 as  a simple  illustrative  example. 


The  parallel-vector  Cholcski  method,  described  in  Section  3, 
uses  a variable-band  storage  scheme  to  achieve  optimal 
vector  performance  combined  with  the  skyline  column 
heights  to  avoid  calculations  with  zeros  outside  the  skyline. 


3,  Parallel-Vector  Choleski  Method  Development 

Basic  Sequential  Choleski  Method 

In  the  sequential  Choleski  method,  a symmetric,  positive- 
definite  stiffness  matrix,  [K],  can  be  decomposed  as 

[K]  = [U1t[U]  (1) 

with  the  coefficients  of  the  upper-triangular  matrix,  [TJ]: 

Uy  = 0 for  i>  j (2) 

un  = : uij  = ^ forJ  - 1 0) 


i-l 

Kji-^Xi2  for  i >1  (4) 

k=l 
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Kij  - Zuki ukj 

Ujj= ^ for  i,  j >1  (5) 

When  j=i,  the  numerator  of  Eq.  5 is  identical  to  Eq.  4 
without  the  square  root  operation,  which  simplifies  coding. 

Regardless  of  whether  the  Choleski  or  Gauss  method  is  used 
(see  Appendix  A),  the  basic  skeleton  FORTRAN  sequential 
code  for  matrix  factorization  is  given  in  Fig.  4 with 
comments  inserted  to  explain  the  connection  to  Eqs.  3-5. 


Fig.  3 Variable-band  storage  of  stiffness  matrix. 


The  non-zero  integers  in  Fig.  3 are  the  index  (location)  of 
each  stiffness  coefficient  stored  contiguously  in  a one- 
dimensional array.  The  34  matrix  coefficients  are  numbered 
row-wise  according  to  a variable-band  storage  scheme,  where 
for  illustrative  purposes,  the  seven  zeros  are  stored  within 
five  of  the  rows.  The  skyline  storage  scheme  requires  only 
29  locations  to  store  the  same  matrix,  since  the  five  zeros 
in  columns  3,  7 and  8 in  Fig.  3 fall  outside  the  skyline  and 
need  not  be  stored.  The  two  zeros  in  row  3 must  be  stored 
in  both  the  variable-band  and  skyline  storage  schemes  since 
they  may  become  non-zero  during  factorization.  The 
bandwidth  of  row  2 in  Fig.  3 is  4,  excluding  the  diagonal 
coefficient,  and  the  height  of  column  6 is  4,  excluding  the 
diagonal  coefficient. 
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DO  1 i = row#l,  row#n 
DO  2 k = top  row#  of  I1*1  column,  i-1 
c compute  multiplication  factor,  xmuk 

xmult  = U(k4) 

cgauss  xmult  = U(kjc)  * U(k,i)  replaces  above  statement 
DO  3 j = i,  k + row  length  of  row  k 
c calculate  the  numerator  of  Eq.  5 

U(i  j)  = K(ij)  - xmult  * U(k  j) 

3 Continue 
2 Continue 

c calculate  final  value  of  (J(i,i)  as  in  Eq.  4 
U(i,i)  = SQRT(U(i,i)) 
cgauss  remove  above  statement 
c DO  loop  4 divides  the  numerator  of  Eq.  5 by  u- * 

xinv  ss  1/U(i4) 

DO  4 j = i+lt  i + row  length  of  row  i 
U(ij)  = U(i  j)  * xinv 

4 Continue 
1 Continue 

Fig.  4 Sequential  Choleski  variable-band 

skeleton  code  for  matrix  factorization. 

To  use  the  Gauss  solution  method  (i.e.,  for  non-posiuve- 
definite  systems  of  equations,  see  Appendix  A),  only  two 
FORTRAN  statements,  labeled  cgauss  in  Fig.  4,  change. 

The  multiplier  constants,  xmult,  and  the  column  height 
information  1 6,20  ^ utilised  in  the  DO  2 loop  in  Fig.  4 
to  avoid  operations  with  zeros  outside  the  column  height  (or 
skyline).  The  parameter,  k,  of  the  DO  2 loop  is  illustrated 
in  Fig.  3.  For  i=6  (in  DO  1 of  Fig.  4),  the  index  k (in  DO 
2)  has  the  values  from  2 to  5 as  shown  in  Fig.  3. 

Although  [K]  and  [U]  are  two-dimensional  arrays  in  Fig.  4, 
in  the  actual  Choleski  factorization  code,  both  are  stored  in  a 
one-dimensional  array  (as  in  Table  3 of  16).  The 
modifications  required  for  the  basic,  sequential  Choleski  code 
to  achieve  optimal  vector  and  parallel  performance  (i.e., 
minimal  solution  time)  are  given  next. 

Vectorize  Choleski  Code  with  Loop  Unrolling 

For  a single  processor  with  vector  capability,  the  loop- 
unrolling technique  (suitable  for  SAXPY  operations)  can  be 
exploited  to  significantly  improve  performance.  The 
SAXPY  operation  is  one  of  the  most  efficient  computations 
on  vector  computers  since  vector  operations  are  performed  in 
parallel  on  separate  add  and  multiply  functional  units. 

In  Fig.  3,  for  example,  once  the  first  four  rows  of  the 
factored  matrix,  [U],  have  been  completely  updated,  row  5 
can  be  updated  according  to  the  numerator  of  Eq.  5: 

u5j  = k5j‘u15  * “lj 

- u25  . u2j 

- u35  * u3j  (6) 

* “45  * u4j 


In  Eq.  6,  u^,  U25,  U35  and  U45  are  multiplier  constants. 
Thus,  u15  (or  U25.  u35,  u45),  u^  (or  u2j.  u3j1  u4j)  and  k5j 
play  the  role  of  the  terms  a,  x and  y.  respectively,  in 
SAXPY  operations.  The  SAXPY  operations  in  Eq.  6 are 
also  loop  unrolled  to  level  4 since  operations  on  four  rows 
are  stacked  together  into  one  FORTRAN  arithmetic 
statement.  This  loop  unrolling  is  possible  since  "partial” 
updated  values  of  row  5 can  be  computed  when  any  of  the 
first  four  rows  are  complete. 

In  a previous  paper  using  the  column-oriented  Choleski 
method^,  once  the  first  four  columns  of  the  factored 
matrix,  [U],  were  completely  updated,  all  terms  of  column  5 
were  updated.  For  example,  U25  was  computed  by  Eq.  5 as: 


k25  - (u12  . u15) 
“25  - u22 


(7) 


The  term  U25  in  Eq.  7 was  computed  directly  as  the  "final" 
updated  value,  and  could  not  be  expressed  in  terms  of 
"partial"  updates  as  is  the  case  in  Eq.  6.  Therefore,  the  loop 
unrolling  technique  could  not  be  used  in  this  case.  Instead,  a 

vector  unrolling  strategy^  was  used  to  improve  the  vector 
performance  in  Eq.  5. 

However,  in  the  present  paper,  the  sequential  Choleski  code 
in  Fig.  4 can  be  modified  to  include  loop-unrolling,  say  to 
level  4 as  is  shown  in  Fig.  5. 

DO  1 i = row#l , row#n 
DO  2 k = top  row#  of  i^1  column,  i-1,  4 
DO  3 *j  = i,  k + row  length  of  row  k 
c Eq.  6 (numerator  of  Eq.  5)  code  follows 

U(i,j)  = K(i  j)  - U(k,i)  * U(kj) 

- U(k+l,i)  * LJ(k+l  j) 

- U( k+2,i)  * U(k+2j) 

- U(k+3,i)  * U(k+3  j) 

3 Continue 
2 Continue 

c repeat  loop  2 to  update  i^1  row  by  extra  k values 

c for  DO  2 k = 1.  10,  4,  extra  k values  are  9,10 

U(i,i)  = SQRT(U(i,i)) 
xinv  = 1/U(i,i) 

DO  4 j = i+1,  i + row  length  of  row  i 
U(ij)  = U(i  j)  * xinv 

4 Continue 
1 Continue 

Fig.  5 Vectorized  Choleski  factorization  code 
(with  level  4 loop  unrolling). 

Using  the  loop-unrolling  technique,  the  total  number  of  load 
and  store  instructions  and  operations  between  the  main 
memory  and  the  vector  registers  is  reduced  significantly  for 
nested  DO-loops.  The  modified  outer  loop  (DO  2 in  Fig. 
5),  has  an  increment  equal  to  the  level  of  unrolling,  while 
the  innermost  loop  (DO  3 in  Fig.  5)  contains  more 
arithmetic  computations  in  a single  FORTRAN  statement 
than  the  basic  code.  For  vector  supercomputers,  such  as 
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Cray,  SAXPY  operations  are  known  to  be  faster  than  dot* 
product  operations  used  in  the  skyline  method.  The  use  of  a 
variable-hand  is  preferred  to  the  skyline  storage  scheme  since 
it  permits  the  SAXPY  operations  of  Eq.  6. 

In  addition  to  vector  capability,  modem  high-performance 
computers  also  have  multiple  processors  which  can  operate 
in  parallel.  Considerably  more  work  is  required  by  engineers 
to  achieve  parallel  performance  gains  than  to  achieve  vector 
performance  gains,  since  code  must  be  restructured  for 
processor  synchronization  and  load  balancing.  The  parallel- 
vector  Choleski  method  was  coded  (in  the  Force  parallel 
FORTRAN  language)  as  the  computer  program  pvsolve. 
Pvsolve  will  be  described  after  a brief  synopsis  of  Force. 

Parallel  FORTRAN  Language,  Force 

Force  is  a preprocessor  which  produces  executable  parallel 
code  from  a combination  of  FORTRAN  and  a set  of  simple, 
yet  portable,  parallel  extensions  tailored  to  run  efficiently  on 
parallel  computers^.  The  parallel  extensions  used  in 
pvsolve  are  Prescheduled  DO,  Shared  and  Private 
variables,  Produce  and  Copy.  Prescheduled  DO  causes 
all  processors  to  execute  the  same  DO-loop  statements  in 
parallel  simultaneously  with  each  processor  using  a different 
DO-loop  index.  Variables  can  be  either  Shared  between  all 
processors  or  Private  (each  processor  has  its  own  value  for 
the  same  variable  name).  Care  should  be  taken  to  avoid 
large  Private  arrays,  as  they  are  stored  in  different  memory 
locations  for  each  processor.  Therefore,  Shared  arrays  are 
preferred  to  Private  arrays.  Copy  and  Produce  are  used  to 
synchronize  tasks.  Copy  X into  Y stores  X in  Y only  if  X 
is  "full"  (i.e.,  a signal  to  all  processors  to  resume  their 
computations),  otherwise  the  processor  waits.  Produce  X 
= K assigns  K to  X and  marks  X as  "full”.  If  X is  "full", 
Produce  waits  until  X is  "empty"  (i.e.,  a signal  for 
processors  to  wait)  before  assigning  K to  X,  Force  permits 
algorithms  to  be  independent  of  both  the  computer  and  the 
number  of  processors,  as  the  number  of  processors  is  not 
specified  until  run  time. 

Parallel- Vector  Choleski  Factorization 

In  Choleski -based  methods,  a symmetric,  positive  definite 
stiffness  matrix,  [K],  can  be  decomposed  as  shown  in  Eq.  1. 

For  example,  can  be  computed  from  Eq.  5 as: 


u57  “ k57  * u15  u 17  ' u25  u27  (9) 

If  row  3 has  also  been  completely  updated,  then  the  third 
partially-updated  value  of  u ^ can  be  calculated  as: 

u57(3)  = u57(2)  - u35  "37  0°) 

This  observation  suggests  an  efficient  way  to  perform 
Choleski  factorization  in  parallel  on  NP  processors.  For 
example,  each  row  of  the  coefficient  stiffness  matrix,  [K] . is 
assigned  to  a separate  processor.. 

From  Equation  8,  assuming  NP  = 4,  it  is  seen  that  row  5 
cannot  be  completely  updated  until  row  4 has  been 
completely  updated.  In  general,  in  order  to  update  the  l1^1 
row,  the  previous  (i-1)  rows  must  already  have  been  updated. 
For  the  above  reasons,  any  NP  consecutive  rows  of  the 
coefficient  stiffness  matrix,  [K],  will  be  processed  by  NP 
separate  processors.  As  a consequence,  while  row  5 is  being 
processed  by  a particular  processor,  say  processor  1 , then  the 
first  (5-NP)  rows  have  already  been  completely  updated. 
Thus,  if  the  row  is  being  processed  by  the  p1*1  processor, 
there  is  no  need  to  check  every  row  (from  row  1 to  row  i- 1) 
to  make  sure  they  have  been  completed.  It  is  safe  to  assume 
that  the  first  (i-NP)  rows  have  already  been  completed  as 
shown  in  the  triangular  cross-hatched  region  of  Fig.  6. 


Fig,  6 Information  required  to  update  row  i. 


k57~u15u17  ~u25u27~u35u37~u45u47 
u55 


(8) 


The  calculations  in  Eq.  8 for  the  term  U57  (of  row  5)  only 

involve  columns  5 and  7.  Furthermore,  the  "final  value"  of 
U57  cannot  be  computed  until  the  final,  updated  values  of 

the  first  four  rows  have  been  completed.  Assuming  that 
only  the  first  two  rows  of  the  factored  matrix,  [U],  have 
been  completed,  one  still  can  compute  the  second  partially- 
updated  value  of  U57  as  designated  by  superscript  (2): 


Synchronization  checks  are  required  only  for  the  rows 
between  (i-NP+1)  and  (i-1)  as  shown  in  the  rectangular  solid 
region  of  Fig.  6.  Since  the  first  (i-NP)  rows  have  already 
been  completely  factored,  the  i1*1  row  can  be  "partially" 
processed  by  the  p ^ processor  as  shown  in  Equations  9-10. 

The  vectorized  Choleski  code  in  Fig.  5 has  been  modified  for 
parallel  processing.  The  resulting  skeleton  factorization  part 
of  the  full  pvsolve  code  is  shown  in  Fig.  7 with  parallel 
(Force)  statements  in  boldface  type. 
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Shared  K(2 1090396) 

Private  ij,k,temp,xinv 

{X}  vector  used  to  indicate  when  row  is  finished 
[U]  overwrites  [K]  in  actual  code  to  reduce  storage 
calculate  U(l,l)  in  Eq.  3 on  one  processor 
U(1,1)  = SQRT(K(1,1)) 
divide  row#l  by  U(l,l)  as  in  Eq.  3 
declare  row#  1 finished 
Produce  X(l)  = U(l,l) 
start  all  available  processors 
Presched  DO  1 i = row#2,  row#n 
lock  processor  if  row#  (i-NP)  is  not  finished 
release  lock  when  row  is  finished 
IF(i-NP.GT.  0)  then 
Copy  X(i-NP)  into  temp 
End  if 

DO  2 k = top  row#  of  the  i^1  column,  i-NP,  4 
skip  DO  3 if  all  multipliers  are  zero:  zero  checking 
DO  3 j = i,  k + rowlength  of  row  k 
U(ij)  = K(i j)  - U(k,i)  * U(kj) 

- U(k+l,i)  * U(k+lj) 

- U(k+2,i)  * U(k+2  j) 

- U(k+3,i)  * U(k+3  j) 

3 continue 

2 continue 

: lock  the  processor  if  row#  (i-1)  not  finished 

release  the  lock  when  row#(i-l)  is  finished 

Copy  X(i-l)  into  temp 

DO  4 k=max(top  row#  of  Ith  column,  i-NP+1),  i-1 
DO  5 j = i*  k + rowlength  of  row  k 
U(ij)  = U(i j)  - U(k,i)  * U(kj) 

5 continue 

4 continue 
U(u)  = SQRT(U(U)) 
xinv  = 1/U(ij) 

DO  6 j = i-f  lt  i + rowlength  of  row  1 
U(i  j)  = U(i  j)  * xinv 

6 continue 

c broadcast  to  all  processors  that  row  1 is  finished 

Produce  X(i)  = U(i,i) 

1 End  Presched  DO 

Fig.  7 Parallel-vector  Choleski  skeleton  code 
(with  level  4 loop  unrolling). 

Solution  of  Triangular  Systems 

The  forward/backward  solution  can  be  made  parallel  in  the 
outermost  loop  by  using  synchronization  statements,  and 
can  result  in  excellent  computation  speed-up  for  an 
increasing  number  of  processors  on  computers  where 
synchronization  time  is  fast  compared  to  computation  time. 
However,  on  Cray  computers,  the  computations  for  the 
forward/backward  solution  time  are  so  fast  that  for  better 
performance  in  pvsolve,  they  are  done  on  one  processor 
with  long  vectors  rather  than  introducing  synchronization 
overhead  on  multiple  processors.  A further  time  reduction 
for  one  processor  is  obtained  by  using  loop  unrolling  in  the 
forward  elimination  and  vector  unrolling16  (another  form  of 
loop  unrolling)  in  the  backward  substitution. 


4.  Evaluation  of  Method  for  Structural  Analyses 

To  test  the  effectiveness  of  pvsolve,  described  in  Section 
3,  two  large-scale  structural  analyses  have  been  performed  on 
the  Cray  Y-MP  supercomputer  at  NASA  Ames  Research 
Center.  These  analyses  involved  calculating  the  static 
displacements  resulting  from  initial  loadings  for  finite 
element  models  of  a high  speed  research  aircraft  and  the 
space  shuttle  solid  rocket  booster  (SRB).  The  aircraft  and 
SRB  models  were  selected  as  they  were  large,  available 
finite-element  models  of  interest  to  NASA.  The  Cray  Y- 
MP  was  selected  as  it  is  a high-performance  supercomputer 
with  parallel -vector  capability.  To  verify  the  accuracy  of 
the  displacements  as  calculated  from  the  equilibrium 
equation  (i.e.  fK](x)  = (f)),  the  residual  vector, 

(R)  = IK)  (x)  -{f}  (H) 

is  calculated,  and  the  absolute  error  norm. 


and  strain  energy  error  norm, 

es=(x}T[K]  (x)-{x}T{f)  (13) 

are  evaluated.  If  no  computer  roundoff  error  occurs,  all 
components  in  the  residual  vector,  (R)  are  zero.  However, 
performing  billions  of  operations  during  equation  solution 
introduces  roundoff  which,  for  accurate  solutions,  results  in 
small  values  for  {R } . ea  and  es  in  Eqs.  11-13. 

The  solution  times  using  pvsolve  for  the  SRB  application 
were  also  obtained  on  Cray  2 supercomputers  at  NASA 
Ames  and  NASA  Langley  and  compared  with  solution  times 

for  the  skyline  algorithm  in  a previous  paper  . 

In  the  following  applications,  code  is  inserted  in  pvsolve 
to  calculate  the  elapsed  time  and  number  of  operations  taken 
by  each  processor  for  equation  solution.  The  Cray  timing 
and  performance  utilities  (timef,  hpm,  ja  and  second)  are 
used  to  measure  the  time,  operations  and  speed  of  the 
equation  solution  on  each  processor.  For  each  problem,  the 
number  of  Million  FLoating  point  Operations  is  divided  by 
the  solution  time,  in  Seconds,  to  determine  the  overall 
performance  rate  of  the  solver  in  MFLOPS.  The  timings 
obtained  are  conservative,  since  they  were  made  with  other 
users  on  the  systems.  In  every  case,  times  would  be  less 
and  MFLOP  rates  more  if  pvsolve  were  run  in  a dedicated 
computer  environment. 


High  Speed  Research  Aircraft 

To  evaluate  the  performance  of  the  parallel-vector  Choleski 
solver,  a structural  static  analysis  has  been  performed  on  a 
16,146  degree-of-freedom  finite-element  model  of  a high- 
speed aircraft  concept21,  shown  in  the  upper  right  of  Fig.  8. 
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Fig.  8 Effect  of  more  processors  on  analysis 
time  (High-Speed  Research  Aircraft). 

Since  the  structure  is  symmetric,  a wing-fuselage  half  model 
is  used  to  investigate  the  overall  deflection  distribution  of 
the  aircraft.  The  finite  element  model  of  the  aircraft  is 
generated  using  the  CSM  Testbed18  where  the  stiffness 
matrix  and  load  vector  are  in  the  form  of  processor  ITER 
(with  reset  sipr=-2),  described  further  in  Appendix  B.  The 
half  model  contains  2851  nodes,  4329  4-node  quadrilateral 
shell  elements,  5189  2-node  beam  elements  and  1 14  3-node 
triangular  elements.  The  stiffness  matrix  for  this  model  has 
a maximum  semi-bandwidth  of  600  and  an  average 
bandwidth  of  321.  The  half-model  is  constrained  along  the 
plane  of  the  fuselage  centerline  and  subjected  to  upward  loads 
at  the  wingtip  and  the  resulting  wing  and  fuselage 
deflections  are  calculated. 

The  numerical  accuracy  of  the  static  displacements  calculated 
is  indicated  by  the  small  absolute  and  strain  energy  error 
norms  of  0.000009  and  0.000005,  respectively,  computed 
from  Eqs.  12-13.  These  residuals  are  identical  no  matter 
how  many  processors  are  used.  The  small  values  of  the 
residuals  indicates  that  the  solution  satisfies  the  original 
force-displacement  equation.  The  residuals  are  independam 
of  the  number  of  processors  indicating  no  error  is  introduced 
by  synchronizing  the  calculations  on  multiple  processors. 

The  time  taken  for  a typical  finite  element  code  to  generate 
the  mesh,  form  and  factor  the  stiffness  matrix  is  134  seconds 
on  a Cray  Y-MP  (802  seconds  on  a Convex  220)  of  which 
the  matrix  factorization  is  51  seconds.  Using  pvsolve,  the 
factorization  for  this  aircraft  application  requires  2 billion 
operations  which  reduces  to  1.4  billion  when  operations 
with  zeros  are  eliminated.  Although  CPU  time  is  less  for 
one  processor,  elapsed  time  is  reported  as  it  is  the  only 
meaningful  measure  of  parallel  performance.  Factoring  [K] 
with  no  zero  checking  takes  8.68  and  1.54  elapsed  seconds 
(at  a rate  of  228  and  1284  MFLOPS)  on  one  and  eight  Cray 
Y-MP  processors,  respectively,  as  shown  in  Table  1. 


Table  1 Matrix  decomposition  time  (MFLOPS)  for 
aircraft  on  Cray  Y-MP: 

16,146  equations,  bandwidth=600  max,  321  average 
5,579,839  matrix  size,  499,505  nonzeros 


Processors 

Sec  (MFLOPS) 

Sec  (MFLOPS) 
with  zero-checkine 

1 

8.68  (228) 

6.81  (203) 

2 

4.50  (441) 

3.46  (399) 

4 

2.41  (822) 

1.89  (730) 

8 

1.54  (1284) 

1.29  (1071) 

Eliminating  operations  with  zeros  within  the  variable 
bandwidth  (zero  checking,  see  Fig.  7)  further  reduces  the 
solution  time  to  6.81  and  1.29  seconds,  respectively,  on 
one  and  eight  processors.  However,  the  reduced  time  with 
zero  checking  is  accompanied  by  a reduction  in  computation 
rate  (MFLOPS),  since  the  added  IF  statements  also  reduce 
the  number  of  operations.  The  reduction  in  computation 
time  (nearly  proportional  to  the  number  of  processors)  and 
the  portion  of  time  saved  by  zero-checking  are  shown  in 
Fig.  8.  The  number  above  the  bars  (in  MFLOPS)  in  Fig.  8 
show  the  increased  computation  rate  as  the  number  of 
processors  increases. 

Space  Shuttle  Solid  Rocket  Booster  (SRB) 

In  addition  to  the  high-speed  aircraft,  the  static  displacements 
of  a two-dimensional  shell  model  of  the  space  shuttle  SRB. 
shown  in  the  upper  right  of  Fig.  9,  have  been  calculated. 


Number  of  Cray  Y-MP  Processors 

Fig,  9 Effect  of  more  processors  on  analysis 
time  (Space  Shuttle  SRB). 

This  SRB  model  is  used  to  investigate  the  overall  deflection 
distribution  for  the  SRB  when  subjected  to  mechanical  loads 
corresponding  to  selected  times  during  the  launch 
sequence^.  The  mode!  contains  9205  nodes,  9156  4-node 
quadrilateral  shell  elements,  1273  2-node  beam  elements  and 
90  3-node  triangular  elements,  with  a total  of  54,870  degrees 
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of  freedom.  The  stiffness  matrix  for  this  application  has  a 
maximum  semi-bandwidth  of  900  and  an  average  bandwidth 
of  383.  A detailed  description  and  analysis  of  this  problem 
is  given  in  references  22  and  23. 

The  calculated  absolute  and  strain  energy  residuals  for  the 
static  displacements  are  0.00014  and  0.0017,  respectively, 
from  Eqs.  12-13.  This  accuracy  indicates  that  roundoff  error 
in  the  displacement  calculations  is  insignificant  despite  the 
9.2  billion  floating  point  operations  performed. 

The  time  for  a typical  finite  clement  code  to  generate  the 
mesh,  form  and  factor  the  stiffness  matrix  is  391  seconds  on 
the  Cray  Y-MP  (15  hours  on  a VAX  1 1/785)  of  which  the 
matrix  factorization  is  233  seconds  (51,185  seconds  on 
VAX).  Using  pvsolve,  the  factorization  for  this  SRB 
problem,  requires  40.26  and  6.04  seconds  on  one  and  eight 
Cray  Y-MP  processors,  respectively,  as  shown  in  Table  2. 
Eliminating  more  than  one  billion  operations  on  zeros 
further  reduces  the  solution  time  to  5.79  seconds  on  eight 
processors  but  reduces  the  computation  rate  to  1444 
MFLOPS.  The  CPU  times  are  approximately  10  percent 
less  than  the  elapsed  times  quoted  on  one  processor. 


Table  2 Matrix  decomposition  time  (MFLOPS) 
(shuttle  SRB  on  Cray  Y-MP) 

54,870  equations, band widih=900  max,  383  average 
21,090,396  matrix  size,  1,310,973  nonzeros 


Processors 

Sec.  (MFLOPS) 

Sec.  (MFLOPS) 
wilh  zcro-checkinc 

1 

40.26  (228) 

40  97  (224) 

2 

20.27  (452) 

19.32  (425) 

4 

10.50  (872) 

10.00  (821) 

8 

6.04  (1517) 

5.79  (1444) 

A reduction  in  matrix  decomposition  ume  by  a factor  of 
7.08  on  eight  processors  compared  to  one  processor  (for  zero 
checking)  is  shown  in  Fig.  9.  The  corresponding 
computation  rate  for  this  matrix  factorization,  using  eight 
processors  on  the  Cray  Y-MP  is  1,517  MFLOPS.  The 
previous  fastest  time  to  solve  this  problem  on  the  Cray  Y- 
MP  using  a sparse  solver  was  23  seconds  on  one  processor 
and  9 seconds  on  eight  processors  for  a speedup  factor  of 


For  structural  analysis  problems  with  a larger  average 
column  height,  and  bandwidth  than  the  aircraft  or  SRB 
discussed,  one  can  expect  pvsolve  to  perform  computations 
at  even  higher  MFLOPS  rates  since  the  majority  of  the 
vector  operations  are  performed  on  long  vectors.  For 
example,  a rate  of  1784  MFLOPS  has  been  achieved  by 
pvsolve  for  a structural  matrix  with  an  average  bandwidth 

of  699  on  the  eight-processor  Cray  Y-MP25’26. 

The  decomposition  time  for  the  Shuttle  SRB  matrix  using 
pvsolve,  is  compared  to  the  skyline  algorithm^  in  Fig. 
10  for  1,  2 and  4 Cray  2 processors. 


Fig,  10  SRB  decomposition  time  comparison 
(pvsolve  skyline  method^). 


A reduction  in  decomposition  time  by  a factor  of  2 is  shown 
for  pvsolve  in  the  figure  for  the  Cray  2 at  NASA  Ames. 
An  additional  reduction  in  decomposition  time  of 
approximately  50  percent  is  shown  for  pvsolve  on  the 
newer  Cray  2S  at  NASA  Langley  with  faster  memory  access 
using  static  RAM  compared  to  dynamic  RAM  on  the  Cray  2 
at  NASA  Ames.  The  decomposition  time  for  pvsolve 
using  eight  processors  on  the  Cray  Y-MP  (six  seconds  in 
Fig.  9)  is  a reduction  by  factors  of  23  and  6 when  compared 
to  the  skyline  solution  on  1 and  4 Cray  2 processors, 
respectively,  shown  in  Fig.  10. 

The  above  results  have  been  obtained  using  loop  unrolling 
to  level  9.  On  the  Cray  Y-MP  supercomputer,  the 
performance  continues  to  increase  until  loop  unrolling  level 
9,  after  which  further  performance  gains  are  not  significant 
compared  to  the  complex  coding  required.  The  pvsolve 
code  performed  best  with  an  odd  number  for  loop  unrolling, 
because  both  data  paths  to  memory  are  used  simultaneously 
at  all  times.  The  vector  being  modified  plus  the  9 unrolling 
vectors  make  ten  total  vectors,  an  even  number,  which  keeps 
both  data  paths  busy. 


5.  Concluding  Remarks 

A parallel-vector  Choleski  method  for  the  solution  of  large- 
scale  structural  analysis  problems  has  been  developed  and 
tested  on  Cray  supercomputers.  The  method  exploits  both 
the  parallel  and  vector  capabilities  of  modem  high- 
performance  computers.  To  minimize  computation  time, 
the  method  performs  parallel  computation  at  the  outermost 
DO-loop  of  the  matrix  factorization,  the  most  time- 
consuming  part  of  the  equation  solution.  In  addition,  the 
most  intensive  compulations  of  the  factorization,  the 
innermost  DO-loop  has  been  vectorized  using  a SAXPY- 
based  scheme.  This  scheme  allows  the  use  of  the  loop- 
unrolling technique  which  minimizes  computation  time. 
The  forward  and  backward  solution  phases  have  been  found 
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to  be  more  effective  to  perform  sequentially  with  loop- 
unrolling and  vector-unrolling,  respectively. 

The  parallel- vector  Choleski  method  has  been  used  to 
calculate  the  static  displacements  for  two  large-scale 
structural  analysis  problems;  a high-speed  aircraft  and  the 
space  shuttle  solid  rocket  booster.  For  both  structural 
analyses,  the  static  displacements  are  calculated  with  a high 
degree  of  accuracy  as  indicated  by  the  small  values  of  the 
absolute  and  strain  energy  error  norms.  The  total  equation 
solution  time  is  small  for  one  processor  and  is  further 
reduced  in  proportion  to  the  number  of  processors.  The 
option  to  avoid  operations  with  internal  zeros  in  the  matrix 
further  reduces  both  the  number  of  operations  and  the 
computation  time  for  both  applications. 

Factoring  the  stiffness  matrix  for  the  space  shuttle  solid 
rocket  booster,  which  formerly  required  hours  on  most 
computers  and  minutes  on  supercomputers  by  other 
methods,  has  been  reduced  to  seconds  using  the  parallel- 
vector  variable-band  Choleski  method.  The  speed  of 
pvsolve  should  give  engineers  and  designers  the 
opportunity  to  include  more  design  variables  and  constraints 
during  structural  optimization  and  to  use  more  refined  finite- 
element  meshes  to  obtain  an  improved  understanding  of  the 
complex  behavior  of  aerospace  structures  leading  to  better, 
safer  designs.  Since  the  algorithm  is  independent  of  the 
number  of  processors,  it  is  not  only  attractive  for  current 
supercomputers,  but  also  for  the  next  generation  of  shared- 
memory  supercomputers,  where  the  number  of  processors  is 
expected  to  increase  significantly. 


6.  Appendix  A 


The  row-oriented,  sequential  versions  of  both  the  Choleski 
and  Gauss  methods  are  presented  together  to  illustrate  how 
their  basic  operations  are  closely  related  and  readily 
identified.  To  simplify  the  discussion,  the  following  system 
of  equations  is  used  throughout  this  section: 


[K]{x)  = {f] 


(14) 


where 


[K]  = 


2-10 
-1  2 -1 
.0-1  1 . 


(15) 


and  |f|Jj 

lo 


(16) 
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The  basic  idea  in  both  the  Choleski  and  Gauss  elimination 
methods  is  to  reduce  the  given  coefficient  matrix,  [K],  to  an 
upper  triangular  matrix,  [U].  This  process  can  be 
accomplished  with  appropriate  row  operations.  The 
unknown  vector,  (x),  can  be  solved  by  the  familiar  forward 
and  backward  substitution. 


Choleski  Method 


The  stiffness  matrix  [K]  of  equation  15  can  be  converted  into 
a Choleski  upper-triangular  matrix,  [U],  by  appropriate  row 
operations: 


[ki] =(k  ] = 


[K2]  = 


.[K41  = 


’ 2 

-1 

0 ' 

-1 

2 

-1 

_ 0 

-1 

Ij 

fl 

-1 

0 

’ fi 

-1 

0 

fi 

fl 

0 

i 

- 1 

=>  [K3]  = 

0 

fl 

.fL\ 

2 

fl 

fl 

0 

-1 

1 

0 

-1 

1 ' 

fi 

A. 

0 

- 

’ fl 

A. 

0 

fl 

fl 

0 

fS. 

-& 

II 

ft 

0 

fl 

fl 

fl 

V3 

0 

0 

1 

0 

0 

l 

3 

J 

VT 

where 


Row  1 of  [K2]  = Row  1 of  [K]  WKl(l.l) 

Row  2 of  [K2]  = Row  1 of  [K2]  H2  + Row  2 of  [Kl] 

Row  2 of  [K3]  = Row  2 of  [K2]  H K2(22) 

Row  3 of  [K4]  = Row  2 of  [K3]  * VF  + Row  3 of  [K3] 
Row  3 of  [K5]  = Row  3 of  [K4]  WK4(3,3) 

The  multiplier  constants,  m-j,  used  in  the  forward 

substitution  (or  updating  the  right-hand  side  vector  of  Eq. 
14)  are  the  same  as  terms  in  the  factorized  upper-triangular 
matrix  such  that: 


J_  „ V2 

m12  = u12  = ‘ V2  * m13  = u13  = 0 ’ m23  = u23  = ‘ V3 


The  solution  of  equations  14-16  is: 

w-(i) 

1 1 


(17) 


The 


Gauss  Elimination  Method 


As  in  the  Choleski  Method  just  described,  the  stiffness 
matrix,  [KJ.  of  Eq.  15  can  be  converted  into  a Gauss  upper- 
triangular  matrix  by  appropriate  row  operations. 


[ki]=[k1= 


2-10 

-1  2 -1 

0 -1  1 


For  example,  uj  j = 2 ; U22  = 2 ; and  u3  3 = 3- 
multiplier  m(j  is  obtained  from  the  factored  matrix,  [U],  as: 

m12  = u12  * U11  = " 2 X 2 = 1 

mi3  = U13  * ul  1 = ^ ^ =0 

2 3 

m23  = u23  * u22  = '3  x 2 = l 

Similarities  of  Choleski  and  Gauss  Method 


"2-10' 

2 

-1 0 " 

=>[K2]  = 

0 J-l 
2 

II 

'cn 

£ 

It 

0 

0 -1  1 

0 

°tJ 

In  this  version  of  Gauss  elimination,  the  multipliers 
mjj  can  be  obtained  from  the  factored  matrix,  [U],  as: 


1)  The  Choleski  and  Gauss  solution  procedures  are  quite 
similar  since  both  methods  can  be  expressed  in  terms  of 
row  operations  which  differ  only  by  the  scale-factors  as 
explained  above. 

2)  For  both  methods,  the  multipliers,  m^,  used  in  the 

forward  substitution  (to  update  the  right-hand-side  vector 
of  Eq.  14)  can  always  be  recovered  conveniently  from  the 
factored,  upper  triangular  matrix,  [U], 


m12  = 


!M2 

U11 


1 

2 


0_ 

13  U11  2“ 
u23  _ -1 
u22  - ” 


m23 


An  alternative  version  of  Gauss  elimination  where  the  final 
diagonal  elements  become  1 follows: 


[ki)=[k]= 


2-10 
-1  2 -1 

0 -1  1 


[K2)  = 


1 .10 
0 | -1 
0 -1  1 


1-10 


[K3]  = 


0 1 - 


3 


0 -1  1 


r~ 

1 

.1 

2 

0 

1 

.1 

2 

0 

=*[K4]  = 

0 

1 

2 

■3 

It 

vrT 

It 

0 

1 

2 

‘3 

0 

0 

1 

3 - 

0 

0 

1 

3)  Both  methods  can  be  adapted  to  solve  unsymmetric 

systems  of  linear  equations.  The  basic  procedure  is 
essentially  the  same  as  that  outlined  above  except  that 
the  computer  storage  increases  since  the  lower  triangle 
matrix  of  the  factored  matrix  is  used  to  store  the 
multipliers,  mjj.  In  some  applications,  partial  pivoting 
may  be  useful. 

4)  Since  the  multipliers  of  the  Choleski  method  are  identical 
to  its  factored,  upper  triangular  matrix,  (U],  the  Choleski 
method  is  slightly  more  efficient  than  the  Gauss  method 
However,  the  Gauss  method  can  also  be  used  to  solve 
non-positive-definite  systems  of  equations. 


7.  Appendix  B 

The  input  data  and  arguments  required  to  call  the  equation 
solver,  pvsolve,  together  with  a simple  21-equation 
example  are  given  in  this  Appendix.  The  user  should  have  a 
limited  knowledge  of  parallel  computing  and  the  parallel 
FORTRAN  language  Force17.  Pvsolve  contains  a 
Force  subroutine,  PVS,  which  may  be  called  by  general 
purpose  codes.  The  information  required  by  PVS  to  solve 
systems  of  simultaneous  equations  (i.e.,  [K](uj  = { f) ) is 
transferred  via  arguments  in  the  call  statement 

Forcecall  PVS(a,b.maxa,irowl,icolh,neq,nterms,iif,opf) 

where: 

a = a real  vector,  dimensioned  nterms,  containing  the 
coefficients  of  the  stiffness  matrix,  [K], 


Since  the  final  diagonal  terms  become  one,  in  the  ^ _ a rea|  vector,  dimensioned  neq,  containing  the  load 

computer  code,  the  main  diagonal  of  the  factored  matrix  is  vector  (f)  Upon  retum  from  subrouline  PVS.  b 

used  to  store  the  diagonal  terms  before  scaling.  contains  the  displacement  solution,  (u) . 
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maxa  = an  integer  vector,  dimensioned  neq,  containing  the 
location  of  the  diagonal  terms  of  [K]  in  vector  (a), 
equal  to  the  sum  of  the  number  coefficients. 

irowi  = an  integer  vector,  dimensioned  neq,  containing  the 
row  lengths  (i.e.,  half- band  width  of  each  row 
excluding  the  diagonal  term)  of  [K], 

icolh  = an  integer  vector,  dimensioned  neq,  containing  the 
column  heights  (excluding  the  diagonal  term)  of 
each  column  of  the  stiffness  matrix,  [K]. 

neq  = number  of  equations  to  solve  (=  degrees  of  freedom). 

nterms  = the  dimension  of  the  vector,  (a),  [=  maxa(neq)]. 

iif  = 1 factor  system  of  equations  without  internal  zero  check 
= 2 factor  system  of  equations  with  internal  zero  check 
= 4 perform  forward/backward  substitution 
= 5 perform  forward/backward  substitution  and  error  check 

opf,  ops  = an  integer  vector,  dimensioned  to  the  number 
of  processors  (8  for  Cray  Y-MP),  containing  the 
number  of  operations  performed  by  each  processor 
during  factor  and  solve,  respectively. 

For  example,  the  values  of  these  input  variables  to  solve  a 
system  of  21  equations,  whose  right  hand  side  is  the  vector 
of  real  numbers  from  1.  to  21.,  and  [K]  is  the  symmetric, 
positive-definite  matrix  in  Fig.  B1  are  given  in  Table  Bl. 


Fig.  Bl  Example  [K]  matrix  with  21  equations. 


The  line  in  Fig.  Bl  represents  the  skyline  defined  by  the 
column  heights  which  extend  up  to  the  last  nonzero  in  each 
column.  The  Mextra  zeros”  outside  the  skyline  (in  boldface 
in  Fig.  Bl)  are  required  to  achieve  level  9 loop  unrolling. 
The  DO  2 loop  in  Fig.  5 illustrates  this  for  level  4 loop 
unrolling.  The  vectors  (a),  (b),  (maxa),  (icolh),  and 
(irowi)  which  are  read  by  pvsolve  are  given  in  Table  Bl: 


Table  Bl  Pvsolve  input  to  solve  lK|{x}  = {b} 
(example  with  21  equations) 


i 

a(i) 

bin 

maxafil 

icolh(i) 

irowlfh 

1 

1. 

1. 

1 

0 

11 

2 

.2 

2. 

13 

1 

10 

3 

0 

3. 

24 

1 

9 

4 

.4 

4. 

34 

3 

8 

5 

0 

5. 

43 

3 

7 

6 

0 

6. 

51 

4 

6 

7 

0 

7. 

58 

2 

5 

8 

0 

8. 

64 

1 

4 

9 

0 

9. 

69 

5 

3 

10 

0 

10. 

73 

1 

10 

11 

0 

11. 

84 

2 

9 

12 

0 

12. 

94 

3 

8 

13 

5. 

13. 

103 

3 

7 

14 

.6 

14. 

111 

4 

6 

15 

.7 

15. 

118 

5 

5 

16 

.8 

16. 

124 

3 

4 

17 

.9 

17. 

129 

3 

3 

18 

0 

18. 

133 

2 

2 

19 

0 

19. 

136 

3 

2 

20 

0 

20. 

139 

4 

1 

21 

0 

21. 

141 

1 

0 

22 

0 

23 

0 

24 

10. 

25 

.11 

26-33 

0 

34 

14. 

35 

.15 

36 

.16 

37-38* 

0 

39 

.19 

135 

0 

136 

70. 

137 

.71 

138 

0 

139 

72. 

140 

.73 

141 

74. 

where  neq  = 21  and  nterms  =141.  This  input  data  is  read  at 
the  beginning  of  the  pvsolve  program  from  the  file 
COEFS.COLM'  by  subroutine  CSMIN  (see  listing  in 
Appendix  C).  The  Force  subroutine,  PVS  is  then  called 
twice;  first  to  factor  the  matrix  (iif  = 2),  and  second  to 
perform  the  forward/backward  solution  for  displacements 
with  error  checking  (iif  = 5).  A record  is  kept  of  number  of 
floating  point  operations  performed  by  each  processor  to 
factor  and  solve  the  matrix  (totf,  tots)  as  well  as  the  elapsed 
(ei0-et5)  and  task  CPU  time  (t0-t5)  on  each  processor  at  six 
key  stages  in  the  solution.  Subroutine  NORM  reads  the 
original  matrix  and  load  vector  from  the  file 
’COEFS.COLM’  and  evaluates  the  residual  (Eq.  1 1)  and  the 
error  norms  (Eqs.  12-13). 


8.  Appendix  C 

A listing  of  the  parallel-vector  solution  algorithm, 
pvsolve,  coded  in  the  parallel  FORTRAN  language. 
Force17,  follows  in  this  Appendix.  The  code  extends  the 
skeleton  code  in  Fig.  7 considerably  by  using  loops  unrolled 
to  level  9 (instead  of  4),  onc-dimcnsional  vectors  with 
pointers  (instead  of  arrays)  and  by  including  the  code  for 
input/output,  data  handling,  initialization,  timing  and 
counting  operations.  Following  the  pvsolve  code  is  the 
command  file  used  to  obtain  the  static  displacements  for  the 
aircraft  and  SRB  structures  using  the  Solid  Slate  Disk  and 
1,2,4  and  8 Cray  Y-MP  processors.  The  pvsolve  code  is 
all  FORTRAN  except  for  the  cdir$  ivdep  vector  directive, 
and  the  Force  parallel  directives  in  boldface  type.  The 
dimension  of  the  variables  given  on  line  2 is  for  the  static 
analysis  of  the  16.146  equation  research  aircraft  and  should 
be  replaced  by  the  dimensions  given  in  line  3 to  obtain  the 
space  shuttle  SRB  displacement  solution  All  variables  are 
Private  unless  they  are  declared  as  Shared. 

Force  PVSOLVE  of  np  Ident  me 
Shared  real  a(5208900),b(16150),at(499600),opf(8) 
csrb  Shared  real  a(21090500).b(54890).at(l 350761) 

Shared  real  tO(8).tl(8).t2(8).t3(8),t4(8).t5(8),op$(8) 
Shared  real  ei0(8),etl(8),et2(8),et3(8),et4(8),et5(8) 

Shared  integer  maxa(16150).irow(16150),irowl(16l50) 
Shared  integer  icoln(499600),icolh(16150),nc,neq 
End  declarations 

et0(me)=timef()/1000. 
tO(me)=second(  )/np 

if  (me.eq.l)  then  call  CSMIN(a,b,maxa,irowl,icolh.neq. 

+ nterms.irow.icoln.nc.maxbw  ,8,locrow,iavebw) 

write(V)'*  PVSOLVE  - pvsolve  - PVSOLVE  Mar.  1990' 
write(*.*)'*  Parallel-Vector  equation  SOLVEr  by  Olaf 
write(*,*)'*  Storaasli,  Tarun  Agarwal  and  Due  Nguyen' 
write(*,*)‘*  \np,’  proc.  solve  '.neq.'  equations,  nc=  '.nc 
wrile(*.*)‘*  bandwidth:  max=  '.maxbw,'.  avg.=  '.iavcbw 
write(*,*)'*  [k]  matrix  size,  nterms=  '.nterms,'  words' 
endif 

etl(me)=timef()/1000. 

tl(me)=second()/np 

Barrier 
End  barrier 

et2(me)=timef()/1000. 
t2(me)=second(  )/np 

call  PVS  to  factor  [k]  with  internal  zero  check  (iif  = 2) 

iif  — 2 

Forcecall  PVS(a.b,maxa,irowl.icolh,neq.nterms,iif.opf(mc)) 
et3(me)=limef(yiWX). 
t3(me)=second()/np 

call  PVS  to  backsolve  for  (u)  (iif  = 4,  5 error  check  eqs.  11-13) 


Lmax  1 =0 
imax2=0 
urn ax 3=0 
totf=0 
iots=0 

wnte(W**  elapsed  & epu  task  lime  (sec)  •****' 
wTite(*t*)'proc.  force  input  Barrier  factor  f/b' 
do  2 i=l,np 

write(*,3)’wall  ,i,et0(t),ci  1 (i),et2(i).c«3< i).et4(i) 
write(*,3)’tcpu  \i,t0(i),tl(i),t2(i),t3(i).l4(i) 
Lmaxl=max(tmaxl,et3(i)-et2(i)) 
Lmax2=max(tmax2,et4(i)-et3(i)) 
Imax3=max(tmax3,et4(i)-ei2(i)) 
totf=iotf+opf(i)/l  000000. 

2 tots=tots+ops(i)/l  000000. 

3 format(a,i2,5f9.5) 

write(*,*)  imaxl,'  secs  decomp,  ',totf, 

+ ' million  ops.  ai  ’.lotf/tmaxl,'  mflops 
write(*,*)  tmax2,’  secs  solve  , *,tots. 

+-  ’ million  ops.  at  \tots/tmax2,*  mflops* 
write(*,*)  tmax3,’  secs  TOTAL  , \totf+tots, 

+ ' million  ops.  at  \(u>ts+totf)/tmax3,'  mflops’ 

End  barrier 

ei5(me)=timef()/l000. 

t5(me)=second()/np 

write(V)’proc.  '.me,'  tot  wall=\et5(me),’tcpu=\t5(mc) 
call  exil(0) 

Join 

end 

Forcesub  P V S( a, b,maxa,irowl,icolh, neq, nterms, iif, ops) 
+ of  np  Ident  me 
dimension  a(*).b(*),icolh(*),maxa(*),irowl(*) 

Async  real  x(16150) 

End  declarations 
if(iif.le.2)  then 
Presched  do  9 i = 1,  neq 
Void  x ( i ) 

9 End  presetted  do 
ops  = 0 
Barrier 

a(l)  = sqrt(a(l)) 
xinv=  1.0/a(l) 
cdir$  Ivdep 

do  20  k = 1,  irowl(l) 

20  a(k+l)  = xinv*a(k+l) 

ops  = ops  + irowl(l)+2 
Produce  x(l)=a(l) 

End  barrier 

c factor  stiffness  matrix  in  parallel  from  row  2 to  neq 

Presched  do  100  i = 2,  neq 
iml  = maxa(i) 
icl  = icolh(i) 

c ..get  indices  to  segment  column  i in  3 parts 

ibot  = i - 9*(  (i-lV9  ) 
icol  = icl  - ibot  + 1 


Forcecall  PVS(a,b,maxa.irowl,icolh.neq, nterms, iif.ops(mc)) 
et4(me)=timef()/1000. 
t4(me)=second()/np 
Barrier 

nal=499600 
umax  = abs(b(l)) 
do  1 i=l, neq 

1 umax  = imaxl  (umax,abs(b(i))) 

write(*,*)'*  Maximum  displacement  = ’.umax 
if(iif.eq.5  ) call  NORM(irowl,icoln,b,neq,nc) 
c reorder  displacements  and  write  to  CSM  Testbed 

call  TOCSM(b,irowl,icoln,at,at,icoln,8,nat) 


icolp=  icol/9 
itop  = icol  • 9*icolp 
jrow  = i - icl 
jml  = maxa(jrow)  *♦-  icl 
jjrow=irowl(jrow) 

if  (itop.  ge.  1)  then 
icopy  = jrow  + itop  - 1 
if  (isfull(x(icopy)))  go  to  331 
Copy  x(icopy)  into  temp 
endif 

33  j go ’ to  ’( 1 0 1.1 02,  i 03,1 04, 1 05 . 1 06, 107 , 108),  itop 
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go  to  150 

cdlrS  Ivdep 

101  do  111  k = U jjrow-icl  + 1 

kml  = k-1 

111  a(iml+kml)  = a(iml+kml)-a(jml  )*a(jml+kml ) 

go  lo  150 

102  jnv2  - jml  + jjrow 

cdlr$  ivdep 

do  112  k = 1,  jjrow-icl  + 1 
kml  = k-1 

112  a(iml+kml)  - a(iml+kml)-a(jml)*a(jml+kml) 

+ -a(jm2)*a(jm2+kml ) 

go  to  150 

103  jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 

cdlrS  ivdep 

do  113  k = 1,  jjrow  -icl+1 
kml  = k -1 

113  a(iml+kml)  = a(Lml+kml)  - a(jml)*a(jml+kml) 

+ -a(jm2)*a(jm2+kml)  -a(jm3)*a(jm3+kml) 

go  to  150 

104  jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 

cdlrS  ivdep 

do  114  k = 1,  jjrow  -icl  + 1 
kml  = k -l 

114  a(iml+kml)  = a(iml+km  l)-a(jml)*a(jml+kml ) 

+ -a(jm2)*a(jm2+kml)-a(jm3)*a(jm3+kml) 

+ -a(jm4)*a(jm4+kml) 

go  to  150 

105  jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 

cdlrS  ivdep 

do  1 15  k = 1,  jjrow  -icl+1 


-a(jm6)*afjon6+km  1 )-a(jm7)*a(jm7  +kml ) 

go  to  150 

108  jm2  - jml  + jjrow 

jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  2 
jm5  = jm4  +•  jjrow  -3 
jm6  = jm5  *+  jjrow  -4 
jm7  = jm6  + jjrow  -5 
jm8  = jm7  + jjrow  -6 

cdlrS  ivdep 

do  118  k = 1.  jjrow  icl  + 1 
kml  = k -1 

118  a(iml+kml)  = a(iml+kml  )-a(jml  )*a(jml+kjrs  1 ) 

+ -a(jm2)*a(jm2+kml  )-a(jm3)*a(jm3+kml) 

+ -a(jm4)*a(jm4+kml  )-a(jm5)*a(jm5+kml ) 

+ -a(jm6)*a(jm6+kml  )-a(jm7)*a(jm7+kml) 

+ -a(jm8)*a(jm8+kml) 

150  ops  = ops  + itop*(jjrow  -icl+2)*2 
11  = 1 

idiv  = 1 

if  (icolp.le.il)  then 
11  =icolp 
idiv  1 = 1 
else 

idiv  1 =icolp -11+ 1 
endif 
jtop  = icl 
jbot  = icl-itop+1 
do  10  I = 1,  11 
jtop  = jtop  - itop 
jbot  = jbot  - 9* idiv  1 
itop  = 9*  idiv  1 
idiv  1 = idiv 
if  (1. eq.ll)  then 
icopy  = i - 1 
else 

* icopy  = i -jbot  +ibot-l 


kml  = k -1 

115  a(iml+kml)  = a(iml+kml)-a(jml)*a(jml+kml) 

+ -a(jm2)*a(jm2+kml)-a(jm3)*a(jm3+kml) 

+ -a(jm4)*a(jm4+kml)-a(jm5)*a(jm5+kml) 

go  to  150 

106  jm2  - jml  + jjrow 

jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 
jm6  = jm5  + jjrow  -4 

cdlrS  Ivdep 

do  1 16  k = 1,  jjrow  -icl+1 
kml=  k -1 

116  a(iml+kml)  = a(iml+kml)-a(jml)*a(jml+kml) 

+ -a(jm2)*a(jm2+kml)-a(jm3)*a(jm3+kml) 

+ -a(jm4)*a(jm4+kml)-a(jm5)*a(jm5+kml) 

+ -a(jm6)*a(jm6+kml) 

go  to  150 

107  jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 
jm6  = jm5  + jjrow  -4 
jm7  = jm6  + jjrow  -5 

cdlrS  ivdep 

do  117  k = lf  jjrow  -icl+1 
kml  = k -1 

117  a(iml+kml)  = a(iml+kml)-a<jml)*a(jml+kml) 

+ -a(jm2)*a(jm2+kml)-a(jm3)*a(jrn3+kml) 

+ -a(jm4)*a(jm4+kml)-a(jm5)*a(jm5+kml) 


endif 

if(isfull(x(icopy)))  go  to  332 
Copy  x(icopy)  into  temp 

c unroll  to  level  9:  fast  vector  saxpy  operations 

332  do  200  j = jtop,  jbot,  -9 

jjl  = i-j 

jjrow  = irowl(jjl) 
jml  = maxa(jjl ) + j 
jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 
jm6  = jm5  + jjrow  A 
jm7  = jm6  + jjrow  -5 
jm8  = jm7  + jjrow  -6 
jm9  = jm8  + jjrow  -7 
if(iif.eq.2)  then 
if  (a(jm9).ne.0.0)  then 
cdlrS  ivdep 

do  300  k = 1,  irowl(jjl)  -j+1 
kml  * k -1 

300  a(iml+kml)  = a(iml+kml)-a(jml)*a(jml+kml) 

+ -a(jm2)*a(jm2+kml)-a(jm3)*a(jm3+kml) 

+ -a(jm4)*a(jm4+kml)-a(jm5)*a(jm5+kml) 

+ -a(jm6)*a(jm6+kml)-a(jm7)*a(jm7+kml) 

+ -a(jm8)*a(jm8+kml)-a(jm9)*a(jm9+kml) 

ops  = ops  + 18*(irowl(jjl)-j+l) 
else 

if(a(jm4).ne.0.0)  then 
go  to  301 


204 


else 

if((a(jml).eq.0.0).and.(a(jm2).eq.0.0).and. 

+ (a(jm3).eq.0.0))  go  io  302 

endif 
cdir$  tvdep 

301  do  310  k = 1,  irowl(jjl)  -j  +1 

kml  = k -1 

310  a(iml+kml)  = a(iml+kml)-a(jml)*a(jml  +kml) 

+ -a(jm2)*a(jm2+km  1 )-a(jm3)*a(jm3+kml ) 

+ -a(jm4)*a(jm4+kml) 

ops  = ops  + 8*(irowl(jjl)-j+l) 

302  if((a(jm5).eq.0.0).and.(a(jm6).eq.0.0).and. 

(a(jm7).eq.0.0).and.(a(jm8).eq.0.0))  go  to  200 

cdir$  ivdep 

do  320  k = 1,  irowl(jjl)  -j  +1 
kml  = k -1 

320  a(iml+kml)  = a(iml+kml  )-a(jm5)*a0m5+kml) 

+ -a(jm6)*a(jm6+kml)-a(jm7)*a(jm7+kml) 

+ -a(jm8)*a(jm8+km  1 ) 

ops  = ops  + 8*(irowl(jjl)-j+l) 

endif 
else 

cdlr$  ivdep 

do  330  k * l,  irowl(jjl)  * j +1 
kml  * k -1 

330  a(iml+kml)  = a(iml+kml)-a(jml)*a(jml+kml) 

+ -a(jm2)*a(jm2+kml)-a(jm3)*a(jm3+kml) 

+ -a(jm4)*  a(jm4+km  1 )-a(jm5)*  a(jm5  +km  1 ) 

+ -a(jm6)*a(jm6+kml)-a(jm7)*a(jm7+kml) 

+ -a(jm8)*a(jm8+kml)-a(jm9)*a(jm9+kml) 

ops  = ops  + l8*(irowl(jjl)-j+l) 

endif 

200  continue 

10  continue 

ll=i-l 

if  (isfull(x(ll)))  go  to  333 
Copy  x(ll)  into  temp 



333  go  to  (20 1 ,202,203 ,204,205,206,207 ,208)  ibot-1 

go  to  250 

201  jjrow  = irowl(i-l) 

jml  = maxa(i-l)  +1 

cdirS  ivdep 

do  211  k=  1,  jjrow 
kml  = k-1 

211  a(iml+kml)  = a(iml+kml)-a(jml)*a(jml 
+kml) 

go  to  250 

202  jjrow  = irowl(i-2) 
jml  = maxa(i-2)  +2 
jm2  = jml  ♦ jjrow 

cdir$  ivdep 

do  212  k = 1,  jjrow  -1 

kml  = k -1 

212  a(iml+kml)=a(iml+kml)-a(jml)*a(jml+kml) 

+ -a(jm2)*a(jm2+kml) 

go  to  250 

203  jjrow  = irowl(i-3) 
jml  = maxa(i-3)  + 3 
jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 

cdirS  ivdep 

do  213  k = 1,  jjrow  -2 

kml  = k - 1 

213  a(iml+kml)=a(iml+kml)-a(jml)*a(jml+kml) 

+ -a(jm2)*a(jm2+kml)-a(jm3)*a(jm3+kml) 

go  to  250 


1 4 

jjrow  = irowl(i-4) 
jml  = maxa(i-4)  + 4 
jm2  = jml  + jjrow 

jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 

cdirS  Ivdep 

do  214  k = 1, jjrow  -3 
kml  = k -1 

214  a(iml+kml)  = a(iml+kml)-a(jml)*a(jml+kinl) 

+ -a(jm2)*a(jm2+kml  )-a(jm3)*a(jm3+kml) 

+ -a(jm4)*a(jm4+kml) 

go  to  250 

205  jjrow  = irowl(i-S) 
jml  = maxa(i-5)  + 5 
jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  *1 
jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 

cdirS  Ivdep 

do  215  k = 1,  jjrow  -4 
kml  = k -1 

215  a(Lml+kml)  = a(iml+kml)-a(jml)*a(jml+kml ) 

+ -a(jm2)*a(jm2+kml  )-a(jm3)*a(jm3+km  1 ) 

+ -a(jm4)*a(jm4+kml)-a(jm5)*a(jm5+kml) 

go  to  250 

206  jjrow  = irowl(i-6) 
jml  = maxa(i-6)  +6 
jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 
jm6  = jm5  + jjrow  -4 

cdirS  ivdep 

do  216  k = 1.  jjrow  -5 
kml  = k -1 

216  a(iml+kml)  = a(iml-t-kml)-a(jml)*a(jmUkml) 

+ * -a(jm2)*a(jm2+kml)-a(jm3)*a(jm3^kml) 

+ -a(jm4)*a(jm4+kml)-a(jm5)*a(jm5+kml) 

+ -a(jm6)*a(jm6+kml) 

go  to  250 

207  jjrow  = irowl(i-7) 
jml  = maxa(i-7)+7 
jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -l 
jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 
jm6  = jm5  + jjrow  -4 
jm7  = jm6  + jjrow  -5 

cdirS  ivdep 

do  217  k = 1,  jjrow  -6 
kml  = k *1 

217  a(iml+kml)=a(iml+kml)-a(jml)*a(jml+kml) 

+ .a(jm2)*a(jm2+kml)-a(jm3)*a(jm3+kml) 

+ -a(jm4)*a(jm4+kml)-a(jm5)*a(jm5+kml) 

+ -a(jm6)*a(jm6+km  1 )-a(jm7)*  a(jm7+km  1 ) 

go  to  250 

208  jjrow  =irowl(i-8) 
jml  = maxa(i-8)  + 8 
jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 
jm6  = jm5  + jjrow  -4 
jm7  = jm6  + jjrow  -5 
jm8  = jm7  + jjrow  -6 

cdirS  ivdep 

do  218  k = 1,  jjrow  -7 


218 


9 


kml  = k - 1 

a(iml+kml)=a(iml+kml)-  a(jml)*a(jml  +km  1 ) 
+ -a(jm2)*a(jm2+kml)-a(jm3)*a(jm3+kml ) 

+ -a(jm4)*a(jm4+kml)-a(jm5)*a(jm5+kml) 

+ -a(jm6)*a(jm6+kml  )-a(jm7)*a(jm7+krnl ) 

+ -a(jm8)*a(jm8+kml ) 


250 

ops  = ops  + 2*(ibot-l)*(jjrow  -ibot  +2) 

a(iml)  =sqrt(a(iml)) 

xinv  = 1.0/a(iml) 

cdlr$ 

Ivdep 

do  260  k = 1,  irowl(i) 

260 

a(iml+k)  = xinv  *a(iml+k) 

ops  = ops  + Lrowl(i)  +2 
Produce  x(i)  = a(iml) 

100  End  presched  do 
els  e 

c forward  reduction-  unroll  to  level  3 for  fast  vector  speed: 

c each  3 rows  of  [k]  must  end  in  the  same  column  number.. 

Barrier 

ops  = 0 

ibot  = neq  -3*  (neq/3) 
do  510  i = l,neq-ibot,3 
iml  = maxa(i) 
im2  = maxa(i+l) 
im3  = maxa(i+2) 
xmultl  = b(i)/a(iml) 

xmult2  = (b(i+l)  - xmultl  *a(iml+l))/a(im2) 
xmult3  = (b(i+2)  - xmultl  *a(im  1+2) 

+ - xmult2*a(im2+l))/a(im3) 

b(i)  = xmultl 
b(i+l)  = xmult2 
b(i+2)  = xmult3 
cdir$  ivdep 

do  520  j = i+3,  i+irowl(i) 

520  b(J)  = b(j)  - xmultl  *a(iml+j-i) 

+ - xmult2*a(im2+j-i-l) 

+ - xmult3*a(im3+j-i-2) 

510  ops  = ops  + 6*(irowl(i)-2)+  9 
if  ( ibot.eq.l)  then 
b(neq)  = b(neq)/a(maxa(neq)) 
ops  = ops  + 1 
else 

if  (ibot.eq.2)  then 
im  1 = neq  - 1 

b(iml)  = b<iml)/a(maxa(iml)) 
b(neq)  = (b(neq)  -b(iml)* 

+ a(maxa(iml)+l))/a(maxa(neq)) 
ops  = ops  + 4 
endif 
endif 

c back  substitution  with  vector  unrolling  follows... 

b(neq)  = b(neq)/a(maxa(neq)) 
ops  = ops  +1 
jml  = neq  -1 
if  (ibot  eq.  2)  then 
iml  = neq  -l 
b(iml)=(b(iml)- 

a(maxa(im  1 )+l  )*b(neq))/a(maxa(im  1 )) 
ops  = ops  + 3 
jml  = neq  -2 
endif 

if  (ibot  .eq.  0)  then 
iml  = neq  -1 

b(iml)=(b(inil)-a(maxa(iml)+l)*b(neq))/a(maxa(iml)) 
im2  = neq  -2 

b(im2)  =(b(im2)-a(maxa(im2)+l)*b(iml) 

+ -a(maxa(im2)+2)*b(neq))/a(maxa(im2)) 


1 f 

ops  = ops  + 8 
jml  = neq  -3 
endif 

do  1010  l - jml.  1,-3 
iml  = maxa(i) 
im2  = maxa(i-l) 
im3  = maxa(i-2) 
xmultl  = 0.0 
xmult2  = 0.0 
xmuit3  = 0.0 
cdirS  Ivdep 

do  1020  j=i+l,  irowl(i)+i 

xmultl  = xmultl  -r  a(iml+j-i)*b(j) 

xmult2  = xmult2  + a(im2+j-i+l  )*b(j) 

1020  xmuli3  = xmult3  + a(im3+j-i+2)*b(j) 
b(i)  = (b(i)  - xmultl )/a(iml) 
b(i-l)  = (b(i-l)  - a(im2+l )*b(i)  - xmuli2)/a(im2) 
b(i-2)  = (b(i-2)-a(im3+2)*b(i)-a(im3  + l)*b(i-l) 

+ -xmult3)/a(im3) 

1010  ops  = ops  + 6*(irowl(i))  +12 

End  barrier 
endif 
return 
end 

subroutine  NORM(irow.icoln,xjteq,nc) 

dimension  irow(*),icoln(*),x(*),b(neq)tdiag(neq)ioffdia(nc 

c get  error  error  norm:  (a]*{x)  = (b):  read  file  COEFS.COLM 

c ([xqi  iter  with  reset  sipr=-2  in  CSM  Testbed)  where: 

c nc=number  of  nonzero,  off-diagonaJ  terms  of  (k) 

c irow(neq)=no.  of  nonzeros  in  each  row  w/o  diagonal 

c icoln(nc)=column  no.  of  nonzero  terms  of  [k]  by  row 

c diag(neq)=diagonal  terms  of  (k),  b(neq)=load  vector 

c offdia(nc)=nonzero,  offdiagonal  terms  of  (k] 

rewind(8) 

read(8)  neq,ncq2,nc,nc2,jdof,jt,ndof 
read(8)  (irow(i)  ,i=  1 . neq) 
read(8)  (icoln(i),  i = 1 , nc) 
read(8)(  diag(i),  i = 1 , neq  ) 
read(8)(  offdia(i),  i = 1,  nc  ) 
read(8X  b(i),  i s 1 * neq  ) 
icount  = 0 
do  1 i = 1 , neq 

1 diag(i)  = diag(i)  * x(i) 
do  2 i = 1 , neq  - 1 

nonz  = irow(i) 
do  2 j = 1 . nonz 

icount  = icount  + 1 
locate^  icoln(icount) 

diag(i)  a diag(i)  + offdia(icount)*x(locate) 

2 diag(locate)=diag(locate)+offdia(icount)*x(i) 

enorm  = 0.0 
fnorm  = 0.0 
snorm  = 0.0 
do  3 i = 1 , neq 

diag(i)  = diag(i)  - b(i) 

enorm  = enorm  + diag(i)  * diag(i) 

fnorm  = fnorm  + b(i)*b(i) 

3 snorm  = snorm  + diag(i)*x(i) 

write(*t*)'*  ABSOLUTE  error  norm  = \sqrt(enorm) 

relerr  = sqrt(enorm/fnorm) 

write(V)  **  RELATIVE  to  load  = ’.relen 

writc(*,*)  ’*  STRAIN  ENERGY  enor  norm  = snorm 

return 

end 

subroutine  CSMLN(a,b,maxa,irowl,icolh,neqtnierms, 

+ irow,icoln,nc,maxbw,iin,locrow?iavebw) 

dimension  a(*),b(*)Imaxa(*),irowl(*),icolh(*),irow(*),ic 


c read  binary  file  COEFS.COLM  output  by  iter(sipr=-2)... 

open(unit=8,file='COEFS.COLM\form=’  unformatted', 

+ access^sequentiar.status^old’) 
read(iin)  neq,neq2,nc,nc2,jdof,jt,ndof 
rcad(iin)  (irow(i),  i = ljieq) 
read(iin)  (icoln(i),  i=l,nc) 

c initialize  column  heights 

loop  =9 

do  100  i = 1,  neq 
100  icolh(i)  = 0.0 
icount  = 1 
do  1 10  i = 1,  neq- 1 
do  1 10  j =1,  Lrow(i) 
jcol  = icoln(icount) 
nowht  = jcol  - i 

if  (nowht.gt.icolh(jcol))  icolh(jcol)=nowht 
110  icount  = icount+1 

c find  the  row-lengths 

isegl  = loop*neq/loop 
jeount  = 0 
icount  = 1 

do  120  i = l,  isegl,  loop 
jeount  = jeount  + iiow(i) 
if  (icoln(jcount).gt.icoum)  icount=icoln(jcount) 
do  130  j = i+1.  i+loop-1 
jeount  = jeount  + irow(j) 


130  if  (icoln(jcount).gt.icount)  icount=icoln(jcount) 
do  140  j = i,i+loop-l 

140  irowl(j)  = icount  • j 

120  continue 

do  150  i = isegl +l,neq 
150  irowl(i)  = neq  - i 

c locate  diagonal  elements  in  vector  (a) 

maxa(l)  = 1 
do  160  i =1,  neq 

160  maxa(i+l)  = maxa(i)  + irowl(i)  +1 


icount  = 1 
do  1 70  i = 1 , neq- 1 
do  170  j = l,  irow(i) 
jcol  = icoln(icount) 
locate  = maxa(i)  +jcol  - i 
icoln(  icount)  = locate 
170  icount  =icount  +1 

n terms  = maxa(neq+l)  - 1 
do  180  i = 1,  nterms 
180  a(i)  = 0.0 

read(iin)  (a(maxa(i)),  i=l,neq) 
read  (iin)  (a(icoln(i)),i=ljic) 
read(  iin)  (b(IX  i=l,neq) 

c find  maximum  and  average  bandwidths 

maxbw  = 0 
iavebw  = 0 

do  190  i = 1,  isegl,  loop 
if  (irowl(i)  ,gt.  maxbw)  then 
maxbw  = irowl(i) 
locrow  = i 
endif 

190  iavebw  = iavebw  + loop*irowl(i)  - (loop)*(loop-l)/2 
do  200  i = isegl+Lneq 
200  iavebw  = iavebw  + irowl(i) 
iavebw  = iavebw/(neq+l) 
maxbw  = maxbw  + l 
return 
end 

subroutine  TOCSM(xtirowlticoln,b,u,irloj,iin,nat) 
dimension  irowl(*),icoln(*),b(*),u(*),x(*).irtoj(*) 
characterMO  libnam 


common  /con5tr/jt,jdf,jddf,Lnex(6),mexm(6),ksym(3)tq1qq 
c convert  static  displacements  calculated  by  pvsolve 

c to  esm  testbed  joint  reference  frame  for  [k]  (u } = ( f ) 

c assume  each  node  has  6 degrees-of- freedom  ( i.e., 

c u(14)  is  the  2nd  dof  of  node  #3)  and 

c jdof  = number  of  joints  * number  of  dof  per  joint 

read  ‘(a)',libnam 

nu  = Lmopen('old\0,  libnam, 0,1000) 

call  dal(nu,  1 1 ,jt,  18.- 1 .Iseq.ierr.nwds.nedb.ityp, 

+ 4hJDFl,4hBTAB.1.8) 

c read  COEFS.COLM  as  in  subroutine  NORM 

rewind  im 

read(iin)  n,n,nc,nc,jdof,jt.ndof 

if(nat.ge.2*jdof.and.nat.ge.ncoef)  then 

read  (iin)  (irowl(i),i=l,n) 

read(iin)  (icoln(i),i=l,nc) 

read(iin)  (b(i),i=l,n) 

read(iin)  (b(i),i=l,nc) 

read(iin)  (b(i),i=l ,jdoQ 


c COEFS.COLM  stores  joint-to-row  before  row-to-joint. 

c only  row-to-joint  info,  needed,  so  storage  reused... 


read(iin)  (jtorj(i),i=L2*jdof) 
else 

wTite(V*)  ‘error  in  TOCSM:  insufficient  memory' 
endif 

c initialize  joint  displacement 

do  4 i=ljdof 

4 u(i)=0. 

do  1 i=jdof+l,jdof+n 
locate  = irtoj(i) 

1 u(  locate)  = x(i-jdof) 

c put  prescribed  displacements  in  vector  (u) 

do  2 i = jdof+n+ 1,2* jdof 
if(irtoj(i).ne.O)  then 
locate  = irtoj(i) 
u(locate)=  b(i-jdof) 
endif* 

2 continue 

c write  displacements  for  frst  3 joint  locations 

njoint  = jdof/6 
do  3 i=l,3 

11  = (i-l  )*6  + 1 

12  = i*6 


3 wrile(6,5)  i,(u(j),j=il,i2) 

5 format(  jt’,i5,’ disp=\6el  1.3) 

c put  displacements  in  esm  testbed  library  file 

c ’libnam*  (load  set  1,  constraint  set  1) 


iset  = 1 
neon  = 1 
nrhs  = 1 

nwds  = jdof*  nrhs 
call  gmsignfPVSOLVE’) 
call  dal(nu,0,0,0,l,lseq.ien,nwds,jt,jdf.-l» 

+ 4hSTAT,4hDISP,i$et,ncon) 

call  rio(nu,l,2.1seq,l.nrhs,u(l),nwds,-l,jt) 
call  gmclos(nu,0,9999) 
return 
end 

The  command  file  to  compute  static  displacements  for  the 
research  aircraft  and  space  shuttle  SRB  on  the  Cray  Y-MP 
using  1 to  8 processors  follows.  The  first  statements  specify 
the  UNIX  C-shell  is  used  and  the  maximum  number  of 
processors  (NCPUS)  that  may  be  requested  is  8.  The  stiffness 
matrix  data  (COEFS.COLM)  and  program  (pvsolve)  are  then 
copied  to  the  solid  stale  disk  (SWRKDIR).  Using  the  hardware 
performance  monitor,  hpm,  to  count  operations,  times  and 
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MFLOPS,  the  displacements  for  the  aircraft  and  SRB  axe  then 
calculated  by  pvsolve  on  8,4,2  and  l processors.  The 
results  are  appended  to  the  File  ’out*  which,  upon  completion, 
is  copied  to  the  home  directory: 

#!/bin/sh 
NCPUS=8 
export  NCPUS 
cd  SWRKDIR 
date  >out 

cp  /u/ra/storaasl/nasp/COEFS.COLM  . 
cp  /u/ra/storaasl/srb/pv  solve  . 
dale  »out 

hpm  -gO  -d  forcerun  pvsolve  8 »out  2>Scl 
hpm  -gO  -d  forcerun  pvsolve  4 »out  2>&1 
hpm  -gO  -d  forcerun  pvsolve  2 »out  2>&1 
hpm  -gO  -d  forcerun  pvsolve  1 »out  2>&1 
date  »out 

cp  /$cr5/storaasl/srb/COEFS.COLM  . 
date  »out 

hpm  -gO  -d  forcerun  pvsolvesrb  8 »out  2>&1 
hpm  -gO  -d  forcerun  pvsolvesrb  4 »out  2>&1 
hpm  -gO  -d  forcerun  pvsolvesrb  2 »out  2>&1 
hpm  -gO  -d  forcerun  pvsolvesrb  1 »out  2>&1 
date  »out 
cp  out  SHOME 

Pvsolve  is  run  in  the  CSM  Testbed18  structural  analysis 
software  to  compute  the  static  displacements  for  the  SRB 
using  the  ‘spawn  command  in  the  following  runstream  using 
four  Cray  Y-MP  processors: 

testbed 

♦open  1 srb.101 
[xqt  iter 
reset  sipr  = -2 
stop 
♦close  1 

♦spawn  pvsolve  srb.101  4 
♦open  1 srb.101  /old 
[xqt  vprt 

PRINT  STAT  DISP 
(xqt  gsf 
[xqt  psf 
[xqt  exit 

The  ’iter*  reset  option  bypasses  the  lengthy  solution  process 
and  just  formats  the  data  for  pvsolve.  Pvsolve  computes 
the  static  displacements  and  writes  them  to  the  data  set 
STAT. DISP. 1.1  in  the  CSM  Testbed  library  srb.101.  The 
stresses  are  then  calculated  and  printed  based  on  the 
displacements  calculated  by  pvsolve.  The  pvsolve  code 
above  is  compiled  using  force  producing  the  executable  file, 
pvs.  The  pvsolve  in  the  ‘spawn  command  is  the  following 
script  that  resides  in  the  directory  containing  the  CSM 
Testbed  executable  Files: 

forcerun  pvs  S2  «EOF 

SI 

EOF 
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APPENDIX  B:  Parallel  FORTRAN  Listing  of  Subroutine  Golden  Block 


o n 


Force  GOLDB  of  NP  ident  ME 
Shared  REAL  ALPHA ( 30 ) , FVALUE ( 30 ) 

Shared  REAL  A, EPS , AA, FMIN, DELTA 
Shared  INTEGER  K,L,IMAX 
Shared  REAL  T1 ( 10) , T2 ( 10) , TT ( 10) 

Shared  REAL  TMAX 
End  declarations 
Barrier 
C K=4  *NP 

READ ( 5 , * ) A, DELTA, K, EPS 
L=30 

write(6,*)  a , delta , k, 1 , eps 
End  barrier 
T1 (ME) =Tsecnd ( ) 

Forcecal 1 GOLD (K, A, DELTA , FMIN , AA , ALPHA , FVALUE , EPS , L) 

T2 (ME) =Tsecnd ( ) 

TT (ME) =T2 (ME) -T1 (ME) 

Barrier 

WRITE (6,*)  'MIN.  F= ' , FMIN 
WRITE ( 6 , * ) 'ALPHA  =',AA,'with  EPS=',EPS 
IMAX=Ismax (NP , TT , 1) 

TMAX=TT ( IMAX ) 

WRITE (6,*)  'Time  used=',TMAX 
End  barrier 
Join 
END 

c *************************************************** 

Forcesub  GOLD (K, A, DELTA, FMIN , AA, ALPHA, FVALUE, EPS , L)  of  NP  ident  ME 

REAL  ALPHA ( L) , FVALUE (L) 

REAL  A, EPS, AA, FMIN 
Private  INTEGER  J 
INTEGER  K 

Shared  INTEGER  I COUNT , KK, KK1 , KK2 , II , IMIN, IQM1 , IQP1 , I 
Shared  REAL  CC , GR, DB , CCC , BK, SGR, B, A0 
End  declarations 
Barrier 

CC=FLOAT (K**2+4*K) 

SGR=0 . 5 *SQRT ( 5 . 0 ) +0 . 5 
GR=0 . 5* ( FLOAT (K) +SQRT (CC) ) 

KK  = 2*K 
KKl=kk+l 
kk2=kk+2 
ALPHA ( 1 ) =DELTA 
DO  30  1=2,12 

ALPHA ( I ) =ALPHA ( 1-1 ) +DELTA* ( SGR** ( 1-1)  ) 
write ( 6 , * ) ' alpha ( i) ', i , alpha ( i) 

30  CONTINUE 

End  barrier 
Presched  DO  40  J=l,12 
CALL  FUNCT( ALPHA (J) , FVALUE (J) ) 
write(6, *)  'alpha, fvalue' ,alpha( j ) , fvalue( j) 

40  End  Presched  DO 
Barrier 

IMIN=ISMIN ( 12 , FVALUE , 1 ) 

IQM1=IMIN-1 
IQP1=IMIN+1 
A=ALPHA ( IQM1 ) 

B=ALPHA ( IQP1 ) 

A0=A 

write(6,*)  'a,b',a,b 


DB=B-A 

BK=DB/K 

FVALUE ( 1 ) = FVALUE ( IQM1 ) 

FVALUE ( KK1 ) = FVALUE ( IQP1 ) 

FVALUE (KK2) =100000. 00 
ICOUNT=l 
End  barrier 
10  CONTINUE 
Barrier 
ALPHA ( 1 ) =A 

ALPHA ( 2 ) =A+ ( 1 . 0/GR) **IC0UNT*DB 
I I = ABS (1-I COUNT ) 

CCC=BK/ (GR**II) 

DO  20  1=3 , KK1 , 2 
ALPHA ( I ) =ALPHA ( 1-2 ) +CCC 
ALPHA ( I + 1 ) =ALPHA ( I - 1 ) +CCC 
20  CONTINUE 

End  barrier 

Presched  DO  25  J=2 , KK1 

CALL  FUNCT ( ALPHA ( J ) , FVALUE ( J ) ) 

25  End  presched  DO 
Barrier 

IMIN=ISMIN (KK2 , FVALUE, 1) 

FMIN=FVALUE ( IMIN) 

AA=ALPHA ( IMIN ) 

WRITE (6, *)  ' alpha= ' , AA, ' FMIN= ' , FVALUE ( IMIN) 

IQP1=IMIN+1 
IQM1=IMIN-1 
End  barrier 

IF (ABS (A0 -ALPHA ( IMIN) ) . LT.  EPS)  GO  TO  100 

Barrier 

A=ALPHA ( IQM1 ) 

B=ALPHA ( IQP1 ) 

A0=ALPHA ( IMIN ) 

FVALUE ( KK2 ) = FVALUE ( IQP1 ) 

FVALUE ( 1 ) = FVALUE ( IQM1 ) 

ICOUNT=ICOUNT+l 
End  barrier 
GO  TO  10 
100  RETURN 
END 

C ****************************************************** 
SUBROUTINE  FUNCT (T,F) 

REAL  T , F 

REAL  sign, fact, value 
INTEGER  I,j 
C do  40  nn=l , 100 

C F=2 . 0-4 . 0*T+EXP (T) 

C F=COS (T) 

C 40  f=f+f 

c f=2 . 0-4 . 0*t+exp(t) 

F=1 . 0 
sign=l . 0 
do  10  i=2 , 600 , 2 
sign=sign* (-1.0) 
fact=l . 0 
value=l . 0 
do  20  j=l,i 
fact=f act* j 
value=value*t 


20 


f=f+sign* value/ fact 

continue 

RETURN 

END 


APPENDIX  C:  Parallel  FORTRAN  Listing  of  Subroutine  BFGS 


C THIS  PROGRAM  IS  WRITTEN  ON  JULY  20  1989  BY  : MAJDI  BADDOURAH 

C THIS  PROGRAM  WILL  SOLVE  UNCONSTRAINED  NONLINEAR  OPTIMIZATION 
C USING  BFGS  METHOD 

c BFGS  METHOD 

Force  MAB  of  NP  ident  ME 

Shared  DOUBLE  PRECISION  H ( 1000000) , C (800 ), D (800) , X ( 800 ), CS  (800 ) 
Shared  DOUBLE  PRECISION  HI  (100000) 

Shared  DOUBLE  PRECISION  F ( 800 ) , HH ( 800) , G (800 ) , S ( 800 ) , Y (800 ) 

Private  DOUBLE  PRECISION  CP (800) 

Shared  INTEGER  MAXA(800) , ICOLH (800 ) , ISWTCH 

Shared  INTEGER  IFLAG, IW, IR, NTERMS, N, MXNITB, NBW, MXNITS, JFLAG 
Shared  DOUBLE  PRECISION  TOLBFG, TOLSOR, THETIM, TIMAX, PI, DIV 
REAL *8  TIME1 (16) ,TIME2 (16) , TIMER 
Shared  DOUBLE  PRECISION  TIMEE1 (16) , TIMEE2 (16) 

Shared  LOGICAL  TYPE1 , TYPE2 

End  declarations 

Barrier 

DIV  = 1000000. 

PI  = ACOS (-1.0) 

IR  = 5 
IW  = 6 

WRITE (6,*)'  ENTER  NUMBER  OF  EQUATIONS  & 1 FOR  ALFA  2 FOR  NO  ALFA' 
WRITE (6,*)'  ENTER  ISWITCH  ' 

READ ( 5 , * ) N, JFLAG, ISWTCH 
MXNITB  = 500 
MXNITS  = 300 
NBW  = N 

TOLBFG  = 1.0E-01 
TOLSOR  = 1.0E-05 

WRITE (IW,*)'  ENTER  TOL  FOR  BFGS  TOL  FOR  SOR  ' 

READ (5,*)  TOLBFG, TOLSOR 

NTERMS  = 0 

ISUM  = 1 

MAXA ( 1 ) =1 

DO  10  I = 1 , N , 2 

ICOLH (I)  = 0 

ICOLH ( 1+1 ) = 1 

NTERMS  = NTERMS  + ICOLH (I) 

C ISUM  = ISUM  + ICOLH (1-1) 

C MAXA (I)  - ISUM 

C ISUM  = ISUM  + ICOLH (I) 

C MAXA ( I + 1 ) = ISUM 

10  CONTINUE 

C MAXA (N+l ) = MAXA (N)  + ICOLH (N)  + 1 

NTERMS  - NTERMS  + N 
DO  11  I - 1,  N 

11  ICOLH (I)  - I - 1 

CALL  ADD1 (N, ICOLH, MAXA, NTERMS) 

WRITE (6,*)'  NUMBER  OF  EQUATIONS  - ',N 
WRITE (6,*)'  NUMBER  OF  TERMS  - ', NTERMS 
C WRITE (6,*)'  COL  HIEGHT  - ' , (ICOLH (I) , I-1,N) 

C WRITE ( 6, *) ' MAXA-  ' , (MAXA ( I ) , 1-1 , N+l) 

End  barrier 

C TIMEl(ME)  - SECOND () 

C TIME1 (ME ) = TSECND ( ) 

C Critical  TYPE1 

TIME1  (ME)  - TIMERO 
TIMEE1 (ME)  - TIME1 (ME) 

C End  critical 

Forcecall  BFGSOP  ( IW,  IR,  N,  NTERMS, H,  HI, C,  D, X, CP, CS, Y, S, MAXA, ICOLH, 

& MXNITB , MXNITS , TOLBFG, TOLSOR, NBW, F , HH, G, JFLAG, ISWTCH, DIV, PI ) 

C TIME2 (ME)  = SECOND  () 

TIME2  (ME)  = TIMERO 

TIMEE2 (ME)  = TIME2 (ME) 


o o o 


c 

C120 


130 

C 


10 

20 


Barrier 

TIMAX  =0.0 

DO  120  I = 1 , N 

WRITE (IW, *) ' X(  , X ( I) 

WRITE ( IW, * ) 'X(l)  = ' ,X(1) 

WRITE ( IW, * ) 'X(  ' , N,  ' ) = ' , X (N) 

DO  130  I = 1 , NP 

THETIM  « (TIMEE2 ( I ) - TIMEEl(I))  / 1000000. 

WRITE (IW,*)'  PROCESS  NO  : ' , I,  ' TIME  = THETIM 
TIMAX  = MAX  (TIMAX, THETIM) 

CONTINUE 

WRITE (IW,*)  ' THE  MAX  TIME  = ', TIMAX 

WRITE (6,*)'  NP  = ',NP  , ' TIME  - ',TIME2(I)  - TIME 

End  barrier 

Join 

END 

Forcesub  BFGSOP  ( IW, IR, N, NTERMS, H,H1,C,D,X,CP,CS,Y, S ,MAXA, ICOLH, 
MXNITB,MXNITS, TOLBFG, TOLSOR, NBW, F, HH, G, JFLAG , ISWTCH, DIV, PI ) 
of  NP  ident  ME 

DOUBLE  PRECISION  H (NTERMS) , C (N) , D (N) , X (N) , CP (N) , CS (N) , Y (N) 

DOUBLE  PRECISION  S (N) , F (N) , HH (N) , G (N) , HI (NTERMS) 

DOUBLE  PRECISION  TOLBFG, TOLSOR, DIV, PI 
INTEGER  MAXA (N+l) , ICOLH (N) 

Shared  DOUBLE  PRECISION  W, ALFA, SUMS1, SUMS2 , SUMS3 , DELTA, CONST, CONST1 
REAL *8  TCI (16) , TC2 (16) ,TS1 (16) , TS2 (16) , TALFP (16) ,TALFW(16) 

Shared  DOUBLE  PRECISION  TCE1 ( 16) , TCE2 (16) ,TSE1 (16) , TSE2 (16) 

Shared  DOUBLE  PRECISION  TALF1 (16) ,TALF2 (16) 

Private  DOUBLE  PRECISION  SUMP1,SUMP2 

Private  INTEGER  ITEMP 

Shared  LOGICAL  TYPE1, TYPE2 , TYPE3 

End  declarations 

SUMP  1 = 0.0 

SUMP 2 =0.0 

DIV  = 1000000.0 

TSE1 (ME)  =0.0 

TSE2 (ME)  =0.0 

TCE1 (ME)  =0.0 

TCE2 (ME)  =0.0 

TALF1 (ME)  =0.0 

TALF2 (ME)  = 0.0 


Barrier 

READ  Initial  guess  for  BFGS 

Write (6,*)  ' READ  Initial  guess  for  BFGS  , Two  values  ' 

READ (5, *) CONST  , CONST1 

DELTA  = .01 

SUMS1  =0.0 

SUMS 2 =0.0 

ALFA  =1.00 

W = 1.0 

DO  10  I = 1, NTERMS 

H ( I ) = 0.0 

CONTINUE 

DO  20  I = 1 , N 

H (MAXA (I) ) = 1.0 

CONTINUE 

End  barrier 

Barrier 
End  barrier 

Initial  guess  for  BFGS 

Presched  do  11  I = 1 , N,2 
X(I)  = .10 
X(I+1)  = .40 
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End  Presched  do 


Barrier 
End  barrier 

Forcecall  FSTD  (N,C,X,NBW) 

C write ( 6,  *)  ' cl  (i)  c2 (i) ' , c (1) , c (2) 

Barrier 
End  barrier 

Presched  do  8 I = 1 » N 
D ( I ) = - C(I) 

C (I)  = -C(I) 

8 End  Presched  do 

C write (6, *) ' dl (i)  d2 ( i) ' , d ( 1) , d (2 ) 

Barrier 
End  barrier 

C ITTERATION  START  AT  THIS  LEVEL 

DO  100  ICONT  = 1 , MXNITB 


Barrier 
DO  30  I = 1 / N 

SUMS 3 = SUMS 3 + C(I)  * C(I) 

30  CONTINUE 

SUMS 3 = DSQRT (SUMS 3) 

write (iw, *) ' THE  NORM  * ' , SUMS3 
SUMS 1 =0.0 
SUMS 2 =0.0 
End  barrier 

Barrier 
End  barrier 

IF ( SUMS 3 .LT.  TOLBFG  ) GO  TO  110 

TALFP  (ME)  = TIMERO 

TALF1 (ME)  = TALF1 (ME)  + TALFP (ME) 

Barrier 

IF ( JFLAG . EQ . 1)  THEN 

C CALL  ALFAQ  (N, X, D, G, ALFA, TOLBFG, DELTA, C) 

CALL  GOLDEN  (N, X, D, G, ALFA, . 000001, DELTA, C) 

C WRITE (6,*)'  ALFA  > ' , ALFA 

ENDIF 

End  barrier 

TALFW  (ME)  = TIMERO 

TALF2 (ME)  = TALF2 (ME)  + TALFW (ME) 

Presched  do  60  I * 1,N 
X(I)  = X(I)  + ALFA  * D (I ) 

Y (I)  = C(I) 

SUMP 2 = SUMP 2 - C(I)  * D (I) 

60  End  presched  do 

C write (6, *) ' xl (i)  x2 (i) ' , x (1) , x (2) 

Barrier 
End  barrier 

Critical  TYPE1 

SUMS 2 = SUMS 2 + SUMP 2 

SUMP 2 =0.0 

End  critical 


Barrier 
End  barrier 


Presched  do  91  I = 1 , N 
ITEMP  - I 

DO  81  J - MAXA(I)  , MAXA(I)  + ICOLH(I) 
H ( J)  - H ( J)  + C(I)  * C ( ITEMP ) / SUMS 2 
81  ITEMP  * ITEMP  - 1 

91  End  presched  do 

Barrier 
End  barrier 

Forcecall  FSTD  (N,C,X,NBW) 

Barrier 
End  barrier 

Presched  do  70  I = 1,N 
Y ( I ) = C(I)  + Y ( I ) 

SUMP  1 - SUMP  1 + Y(I)  * ALFA  * D(I) 

70  End  presched  do 

Barrier 
End  barrier 

Critical  TYPE1 

SUMS  1 = SUMS1  + SUMP 1 

SUMP  1 - 0.0 

SUMS3  =0.0 

End  critical 

Barrier 
End  barrier 

Presched  do  90  I - 1 , N 
ITEMP  = I 

DO  80  J = MAXA(I)  , MAXA(I)  + ICOLH(I) 
H ( J)  = H ( J)  + Y ( I ) * Y ( ITEMP ) / SUMS1 
80  ITEMP  = ITEMP  - 1 

90  End  presched  do 

Forcecall  FSTD  (N,C,X,NBW) 

Barrier 
End  barrier 

Presched  do  92  I - 1 , N 
C(I)  - -C(I) 

92  End  Presched  do 

Barrier 
End  Barrier 

IF  ( ICONT  .LT.  ISWTCH  ) THEN 
Presched  do  31  i - 1 , nterms 
Hl(i)  - H(i) 

31  End  presched  do 

Presched  do  32  I - 1 , N 
D(I)  - C(I) 

32  End  presched  do 

ENDIF 

Barrier 
End  barrier 


C write (6, * ) ' C ( I ) - ' , (C ( I ) , 1=1 , N) 

C write ( 6 , * ) ' D ( I ) - ' , (D ( I ) , 1=1 , N) 

C wr ite ( 6 , * ) ' h(I)  - ', (h ( I ), i=l , nterms) 

IF ( ICONT  .LT.  ISWTCH  ) THEN 

TCI  (ME)  = TIMERO 

TCEl(ME)  = TCEl(ME)  + TCI (ME) 

Forcecall  FF (HI , MAXA, D , N, 1 , ICOLH) 

Forcecall  FF (HI , MAXA, D, N, 2 , ICOLH) 

TC2  (ME)  = TIMERO 

TCE2 (ME)  - TCE2 (ME)  + TC2 (ME) 

ELSE 

TS 1 (ME ) - TIMERO 

TSEl(ME)  - TSEl(ME)  + TS1 (ME) 

Forcecall  SOR1 (N, NTERMS, H, C, D, CP, CS, MAXA, NBW, TOLSOR, MXNITS , W, ICOLH) 

TS2  (ME ) - TIMERO 

TSE2 (ME)  = TSE2 (ME ) + TS2 (ME) 

END  IF 


C write ( 6 , * ) ' D ( I ) - ' , (D (I) , 1-1, N) 

Barrier 

C DO  140  I = 1 , N 

C140  WRITE ( IW, * ) ' X(  ) = ',X(I) 

End  barrier 

100  CONTINUE 

110  CONTINUE 

Barrier 

WRITE (IW,*)'  NUMBER  OF  ITTERATIONS  - ', ICONT 
C DO  120  I = 1 , N 

C120  WRITE ( IW, * ) ' X(  ' , X ( I ) 

DO  130  I = 1 , NP 

TIMEC  = (TCE2  (I)  - TCE1(I))  / DIV 

TIMES  = (TSE2  (I)  - TSE1(I))  / DIV 

TIMEA  = (TALF2 (I)  - TALF1 (I) ) / DIV 

WRITE (6,*)'  CHOL  TIME  0 PROC  # TIME  - ', TIMEC 

WRITE (6,*)'  SOR  TIME  0 PROC  # ',1,'  TIME  - TIMES 

WRITE (6,*)'  ALFA  TIME  0 PROC  # ',1,'  TIME  - ', TIMEA 

130  CONTINUE 

C Write ( 6, *) ' H(I)  = ',(H(I),I=  1, NTERMS) 

End  barrier 

RETURN 

END 

Forcesub  FSTD  (N,F,X,NBW)  of  NP  ident  ME 
DOUBLE  PRECISION  F(N),X(N) 

Private  INTEGER  MS TART, MEND 

Shared  INTEGER  NBWT 

Private  DOUBLE  PRECISION  SUM 

End  declarations 

NBWT  - NBW  - 1 

Presched  do  20  I - 1 , N 

F ( I ) =0.0 

SUM  =0.0 

MEND  = MIN (N, NBWT+I) 

IF  ( I .LT.  NBW  ) THEN 

MS TART  = 1 

ELSE 

MSTART  = I - NBWT 
END  IF 

DO  10  J = MSTART  , MEND 
IF  ( I .EQ.  J ) THEN 

F ( I ) = F ( I ) + 2.0  * X(I)  * X(J)  * X(J) 


SUM  = SUM  +2.0 
ELSE 

F ( I ) = F(I)  + (1.0/  (I+J)  ) * X ( I ) * X ( J)  * X ( J) 
SUM  = SUM  + (1 .0/ (I+J)  ) 

ENDIF 

10  CONTINUE 

F ( I ) = F(I)  - SUM 
20  End  presched  do 

RETURN 
END 


SUBROUTINE  NEWF  (N,F,X,NBW) 

DOUBLE  PRECISION  F(N),X(N) 

INTEGER  MS TART, MEND 
INTEGER  NBWT 
DOUBLE  PRECISION  SUM 
NBWT  = NBW  - 1 
do  20  I = 1 , N 
F ( I ) = 0.0 
SUM  =0.0 

MEND  = MIN (N, NBWT+I ) 

IF  ( I . LT.  NBW  ) THEN 

MS TART  = 1 

ELSE 

MS TART  = I - NBWT 
ENDIF 

DO  10  J = MS TART  , MEND 
IF ( I .EQ.  J ) THEN 

F ( I ) = F ( I ) + 2.0  * X(I)  * X(J)  * X(  J) 

SUM  = SUM  +2.0 
ELSE 

F ( I ) = F ( I ) + (1.0/(I+J))  * X ( I ) * X ( J)  * X ( J) 
SUM  = SUM  + (1 .0/ (I+J) ) 

ENDIF 

10  CONTINUE 

F ( I ) = F ( I ) - SUM 
20  End  presched  do 

RETURN 
END 

Forcesub  FSTDD11  (N,C,X)  of  NP  ident  ME 

DOUBLE  PRECISION  C(N),X(N) 

DOUBLE  PRECISION  PI 
Shared  DOUBLE  PRECISION  PII 
Private  INTEGER  TEMP10 
End  declarations 
PII  = ACOS ( -1.0  ) 

Presched  do  20  I = 1 , N 

C(I)  = 1.0 

DO  10  J = 1 , N 

IF (I  .EQ.  J)  THEN 

C(I)  = C(I)  * DCOS (X (I) ) 

ELSE 

C(I)  = C(I)  * DSIN (X ( J) ) 

ENDIF 

TEMP 10  = FLOAT (I) 

C(I)  = C(I)  + X(I)  - TEMP 10  * PII 
10  CONTINUE 

20  End  presched  do 

RETURN 
END 

Forcesub  FSTD23  <N,C,X)  of  NP  ident  ME 
DOUBLE  PRECISION  C(N),X(N) 
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End  declarations 
Presched  do  10  I - 1 , N , 2 
C(I)  = 10.0  * X(I)  + 2.0  * X(I  + 1) 

C(I+1)  = 2.0  * X(I)  + 2.0  * X(I+1) 

End  presched  do 
RETURN 
END 

SUBROUTINE  FUNCT  (N,X,SUM,C) 

DOUBLE  PRECISION  X (N) , SUM, C (N) 

SUM  =0.0 
DO  10  I = 1 , N 
SUM  = SUM  + (X  ( I ) * *4 ) / 2.0 
10  CONTINUE 

DO  20  I = 1 , N - 1 
DO  20  J = 1+1  , N 

SUM  = SUM  + { (X  (I)  **2)  * (X  ( J)  **2)  /(2.0MI+J))  ) 

20  CONTINUE 

DO  40  I = 1 , N 
SUMM2  =0.0 
DO  30  J = 1 , N 
IF  ( I .EQ.  J ) THEN 

SUMM2  = SUMM2  + 2 
ELSE 

SUMM2  = SUMM2  + (1.0/ (I+J) ) 

ENDIF 

30  CONTINUE 

SUM  = SUM  - SUMM2  * X(I) 

40  CONTINUE 

C DO  10  I = 1 , N , 2 

C SUM  = (X(I)**4)/2  +(X(I)**2)  * (X(I+l)**2)/6.0  + (X (1+1) **4 ) /2 . 0 

C & - 7 . 0*X (I) /3 . 0 -7 . 0*X ( 1 + 1 ) / 3 . 0 + SUM 

CIO  CONTINUE 

RETURN 
END 


SUBROUTINE  FUNCT9  (N,X,SUM) 

DOUBLE  PRECISION  X(N),SUM 
DO  10  I = 1 , N , 2 

SUM  = 5.0  * (X(I)  **2)  + 2.0  * X(I)  * X(I+1)  + X(I+1)**2  + 7 
& + SUM 

10  CONTINUE 

RETURN 
END 

Forcesub  FSTD19  (N,C,X)  of  NP  ident  ME 
DOUBLE  PRECISION  C(N),X(N) 

End  declarations 
DO  10  I - 1 , N , 2 

C(I)  - X(I+1)  + 2.0  * X(I)  - (X(I+1)**2)  + EXP (X (I) ) 

10  C(I+1)  = X(I)  - 2.0  * X(I)  * X(I+1) 

RETURN 

END 

C SUBROUTINE  FUNCT2  (N,X,SUM) 

C DOUBLE  PRECISION  X(N),SUM 

C SUM  =0.0 

C DO  10  I = 1 , N , 2 

C SUM  = X ( I ) * X ( 1+1 ) + (X (I) **2)  - X(I)  * (X (1+1 ) **2 ) + EXP  (X(I)) 

C & + SUM 
C 10  CONTINUE 
C RETURN 

C END 


C Forcesub  FSTD1  (N,C,X)  of  NP  ident  ME 

C DOUBLE  PRECISION  C(N),X(N) 

C End  declarations 

c C ( 1 ) - 400  * ( (X (1) **2)  - X (2 ) ) * X ( 1 ) - 2.0  * (1.0  - X(l)) 

C C ( 2 ) = -200  * ( (X ( 1) **2 ) -X  ( 2 ) ) 

C RETURN 

C END 

C SUBROUTINE  FUNCT1  (N,X,SUM) 

C DOUBLE  PRECISION  X(N),SUM 

C SUM  = 100  * ( ( (X ( 1 ) **2) -X(2)  ) **2)  + ( (1.0  - X(l))  **2  ) 

C RETURN 

C END 

SUBROUTINE  GOLDEN  (NR, B, S, D, ALFA, TOL, DELTA, C) 

DOUBLE  PRECISION  B (NR) , C (NR) , S (NR) , D (NR) 

DOUBLE  PRECISION  ALFAA, ALFA, ALFAL, ALFAB, ALFAU, FI, F2 , FA, FB, DELTA 
DELTA  - .01 

C write (6,*)  ' subroutine  golden  is  used  after  ' 

C write (6, *) 'delta  tol,  ', delta, tol 

TOLl=TOL 
ALFA=0 . 0 
F1=0 . 0 

DO  30  1-1,30 
ALFAA-ALFA 

10  ALFA-ALFA+DELTA* (1. 618**1) 

DO  20  J=1 , NR 

20  D(J)=B(J)+ALFA*S(J) 

F2=F1 

CALL  FUNCT  (NR,D,F1,C) 

C write ( 6 , * ) ' f 1,  dl, d2 ' , FI, D (1 ) , D (2) 

IF(I.EQ.l)  GO  TO  30 

IF (FI . GT . F2 ) GO  TO  40 
30  CONTINUE 

40  ALFAU-ALFA 

ALF AL= ( ALFAA- .382  * ALFAU ) / . 6 1 8 
ALFAB- .618* (ALFAU-ALFAL) + ALFAL 
DO  50  N— 1 , NR 

50  D (N) =B (N) +ALFAB*S (N) 

CALL  FUNCT  (NR, D, FB, C) 

C write  ( 6 , * ) ' f 2 , dl, d2 ' , Fb, D (1 ) , D (2) 

DO  60  N-l , NR 

60  D(N)=B(N)+ALFAA*S(N) 

C write  ( 6 , * ) ' fa,  dl,  d2' , Fb,  D (1)  , D (2) 

CALL  FUNCT  (NR, D, FA, C) 

C * WRI TE ( 6 , * ) ' ALFAL , ALFAU ' , ALFAL , ALFAU 

DO  90  KJ-1,100 
C WRITE (6,*) 

C WRITE ( 6 , * ) KJ 

C WRITE ( 6 , * ) 

IF(FA.LT.FB)  THEN 

ALFAU-ALFAB 

ALFAB-ALFAA 

ALFAA-ALFAL+ .382* (ALFAU-ALFAL) 

FB-FA 

DO  70  N-l, NR 

70  D(N)=B(N)+ALFAA*S(N) 

CALL  FUNCT  (NR, D, FA, C) 

ELSE  IF (FA. GT .FB)  THEN 

ALFAL-ALFAA 

FA-FB 

ALFAA-ALFAB 

ALFAB-ALFAL+ .618* (ALFAU-ALFAL) 

DO  80  N-l, NR 

80  D(N)=B(N)+ALFAB*S(N) 

CALL  FUNCT  (NR, D, FB, C) 


ELSE  IF(FA.EQ.FB)  THEN 
ALF  AL=ALF  AA 
ALFAU=ALFAB 

ALFAA=ALFAL+. 382* ( ALFAU-ALFAL ) 

ALFAB=ALFAL+ .618* (ALFAU-ALFAL) 

END  IF 

IF (DABS (ALFAA-ALFAB) . LT .T0L1)  GO  TO  100 
90  CONTINUE 

100  ALFA= (ALFAA+ALFAB) /2 

C WRITE (6, *) 'ALFA  ***********' , ALFA 

RETURN 
END 

SUBROUTINE  ALFAQ  (NR, B, S, D, ALFA, TOL, DELTA, C) 

DOUBLE  PRECISION  B (NR) , S (NR) , D (NR) , C (NR) 

DOUBLE  PRECISION  ALFA, TOL  , DELTA, FI , F2, F3, CC1 , CC2 , CHEK, ALFA2 , ALFA1 
DOUBLE  PRECISION  ALFA 3 
INTEGER  JCONT 

WRITE ( 6 ,*)'*★****** * SUBROUTINE  ALFAQ  IS  USED  **********' 

WRITE (6,*)  ' ALFA  = ',ALFA, ' TOL  = ',TOL, ' DELTA  = DELTA 

JCONT=l 
ALFA1=0 . 0 
ALFA2=DELTA 
10  ALFA3=2*ALFA2 

CALL  FUNCT  (NR,B,F1,C) 

write(6,*)  ' FI  = ',F1 
DO  20  1=1, NR 

20  D ( I ) =B ( I ) +ALF A2  * S ( I ) 

CALL  FUNCT  (NR,D,F2,C) 

write  (6, *)  ' F2  = ' , F2 
DO  30  1=1, NR 

30  D ( I ) =B ( I ) +ALFA3  *S ( I ) 

CALL  FUNCT  (NR,D,F3,C) 

write(6,*)  ' F3  = ',F3 
CHEK= ( (F3+F1) / 2 ) -F2 
WRITE ( 6 , 35 ) F3 , F2 , FI , ALFA2 , CHEK 
35  FORMAT (7F 10 .3) 

IF (CHEK . LT .0.0)  GO  TO  40 
CC1=(4.0*F2-3.0*F1-F3) / (2  *ALFA2 ) 

CC2=(F3+F1-2.0*F2) / (2 . 0* (ALFA2**2) ) 

IF (CC2 . EQ . 0 . 0 ) GO  TO  50 
ALFA=-CC1/ (2 . 0*CC2 ) 

GO  TO  50 

40  ALFA2=ALFA2+ALFA2* (1 . 618**JCONT) 

WRITE (6,*)'  CHEK', CHEK 
IF(ABS(CHEK) .LT.1.0D-40)  THEN 

WRITE (6,*)'  THE  FUNCTION  DOES  NOT  HAVE  ANY  MIN  POINT' 

GO  TO  60 
ENDIF 

JCONT= JCONT+1 
GO  TO  10 
60  STOP 

50  RETURN 

END 


Forcesub  FF (A,MAXA, B, NEQ, M, ICOLH)  of  NP  ident  ME 
DOUBLE  PRECISION  A(1),B(1) 

INTEGER  MAXA(l) , ICOLH (1) 

Shared  INTEGER  jops(16) 

Private  INTEGER  I,J,K,L  , ipdig  , iloc, idig, ii, j j, i4, 11, i5, i6 
Private  INTEGER  IP 1 , IP 2 , IIpl , IIp2 , IP loc, IPLOCa, IP3, IP4, I IP 3, IIP4 
Private  INTEGER  Jpl, Jp2 , J jpl , JJp2 

Private  DOUBLE  PRECISION  SUM1, SUM2 , SUM3, SUM4 , Y1 ( 10000 ), Y2 ( 10000) 
Private  DOUBLE  PRECISION  SUM, TEMP 
Shared  INTEGER  IS1,IS2,N 


c 


INTEGER  NEQ, M, iops 
Shared  Logical  ialoc 
Async  DOUBLE  PRECISION  X (10001) 

Async  DOUBLE  PRECISION  X (10001) 

End  declarations 

c 

c Barrier 

C WRITE (6,*)  'MAXA(I)-  ' , (MAXA { I ), 1=1 , NEQ+1 ) 

C WRITE ( 6 , * ) ' ICOLH ( I ) = ' , ( ICOLH ( I ) , 1=1 , NEQ) 

C WRITE ( 6 , * ) ' A (NTERMS ) = ( A ( I ) , 1=1, MAXA (NEQ+1 ) -1 ) 

C WRITE ( 6 , * ) ' B (NEQ) = ( B { I ) , 1=1 , NEQ) 

c End  barrier 


IF(M.EQ.l)  THEN 

Presched  DO  10  1=1, NEQ 
Void  X(I) 

10  End  Presched  DO 
jops=0 
Barrier 
jops=0 
jops= jops+1 
Produce  X(1)=A(1) 
isl=neq  - 2*(neq/2) 
if  (isl.eq.0)  then 
isl=2 

if  (maxa(3)  .eq.  4)  then 
a(3)=a(3)/a(l) 
a (2)  = (a (2) -a(3) *a(3) *a(l) ) 
jops= jops+4 
Produce  x(2)=a{2) 
else 

jops= jops+1 
Produce  x(2)=a(2) 
endif 
endif 

End  barrier 

Presched  DO  20  I=isl+1 , neq, 2 
IP1=MAXA ( I ) 

IP2=MAXA ( 1+1 ) 

IIpl=IPl+I 
IIp2=IP2+i+l 
IPLOC=I-ICOLH (I) 

IIP3=  ICOLH(I) -2* (ICOLH  (I) /2) 

IPLOCA-IPLOC 
IF  (IIP3.EQ.1)  THEN 
IPLOCA  = IPLOC  +1 
ENDIF 

IIP4  = IPLOCA  +2*  (((  ICOLH  (I) /2)  +1)  /2)  -1 
Copy  X (IIP4)  into  TEMP 
IF  (IIP3.EQ.1)  THEN 
yl (iploc) =a  (iipl-iploc) 

A (IIP1-IPLOC)  = yl (IPLOC) /A (MAXA (IPLOC) ) 
y2 (iploc)  =a (iip2-iploc) 

A (IIP2-IPLOC)  = y2 (IPLOC)  /A (MAXA (IPLOC) ) 
jops= jops+4 
ENDIF 

25  continue 

DO  30  J-IpLOCa, IIP4 , 2 
Jpl-MAXA(J) 

JP2—MAXA ( j+1 ) 

JJP1-  JP1+J 
JJP2-  JP2+J+1 
SUM1-0 .0 
sum2=0 . 0 
sum3=0 . 0 


sum4=0 . 0 

ipdig=j  - icolh(j) 

if  ( IPLOC  .gt.  IPDIG)  IPDIG-IPLOC 

c if ( A ( Ipl ) -SUM. LE . 0 . 0 ) write(*,*)  'Matrix  not  pos . definite' 

CDIR$  IVDEP 

DO  40  k=IpDIG, J-l 

suml-suml+a (jjpl-k) *Y1 (k) 
sum2=sum2+a (jjpl-k) *y2 (k) 
sum3=sum3+a ( j jp2-k) *yl (k) 
sum4=sum4+a ( j jp2-k) *y2 (k) 

40  CONTINUE 

lth= j-ipdig 

if  (lth.gt.O)  jops=jops+  8*lth 
yl(j)=  (a (iipl- j) -suml) 
y2 ( j ) = (a (iip2- j) -sum2) 
a ( iipl- j ) - yl(j)/a(jpl) 
a (iip2- j ) = y2 ( j ) /a ( jpl ) 
yl  ( j + 1 ) = (a (iipl- j-l) -sum3-yl ( j) *a  ( j jp2-j) ) 
y2  ( j +1 ) = (a  (iip2- j-l) -sum4-y2 ( j) *a ( j jp2-j) ) 
a(iipl-j-l)=  yl ( j+1) /a ( jp2) 
a(iip2-j-l)  - y2 ( j+1) /a ( jp2) 
jops=jops  + 12 
30  CONTINUE 

IF  (IIP4  .LT.  1-1)  THEN 
IPLOCA=IIP4+l 
IIP4-I-1 

Copy  X ( IIP4 ) into  TEMP 
go  to  25 
ENDIF 

suml=0 . 0 
sum2=0 . 0 
sum3=0 . 0 

DO  50  K=IpLOC, 1-1 

suml=suml+a (iipl-k) *yl (k) 
sum2=sum2+a (iipl-k) *y2 (k) 
sum3=sum3+a (iip2-k) *y2 (k) 

50  CONTINUE 

jops  « jops  + 6*(i-iploc) 
a (ipl ) = (a (ipl ) -suml ) 

Produce  X(i)-a(ipl) 
a (ip2+l) - (a (ip2+l) -sum2) /a (ipl) 

a(ip2)  - (a(ip2)  -sum3  -a (ip2+l) *a (ip2+l) *a (ipl) ) 
k=i+l 

Produce  X(K)-a(ip2) 
jops-jops  + 8 
20  End  Presched  do 

ELSE 
jops-0 
Barrier 
jops- jops+1 
isl=neq-2* (neq/2) 
if  (isl.eq.0)  then 
isl-2 

if  (maxa (3) .eq. 4)  then 
B (2)  - (b  (2)  -a  (3)  *b  (1) ) 
jops- jops+3 
endif 
endif 

DO  510  I=isl+1 , neq, 2 
SUM=0 . 

suml=0 . 0 

JJ—MAXA ( I ) 

II—ICOLH ( I ) 


jpl-maxa  ( i + 1)  +1 
DO  520  J-II, 1, -1 
SUM=SUM+A< JJ+J) *B(I-J) 
suml=suml+a  ( jpl+ j ) *b ( i- j ) 

520  CONTINUE 

jops- jops+ii*2+8 
B ( I ) = ( B { I ) -SUM) 

b { i+1 ) - (b ( i+1 ) -suml  -b (i) *a ( jpl ) ) 

510  continue 

do  1005  i»l,neq 
b (i)  -b (i) /a (maxa ( i ) ) 

1005  continue 

DO  1010  I=NEQ, isl+1, -2 
JJ-  MAXA (I) 
jpl-maxa ( i-1) 

B(I)-B(I) 

B (1-1) - (b  (i-1)  -a ( j j+1) *b  (i) ) 
lth=icolh  (i) -1 
c$dir  no_recurrence 

DO  1020  J-I-ICOLH(I) ,1-2 

B( J) -b ( J) -B(I) *A ( JJ+I- J) -b (i-1) *a( jpl+i- j-1) 
1020  CONTINUE 

if  (lth.gt.0)  jops- jops+lth*4+4 
1010  Continue 

jops= jops+1 
if  (isl.eq.2)  then 

if  (maxa(3)  .eq.  4)  then 
b (1)  - (b  (1)  -a  (3)  *b  (2)  ) 
jops- jops+3 
else 

jops-  jops  + 1 
endif 
endif 

C OUTPUT  FROM  LINEAR  SOLVER 

C*****c  WRITE (6, 78 ) (B(I), 1-1,6) 

78  FORMAT <2X, ' SOLVER-' , 6E11 . 4 ) 

End  Barrier 
ENDIF 
RETURN 
END 

C%% %%%%%%%%%%%%%% %%%%%%%%%%%% 

SUBROUTINE  ADD1 (NEQ, ICOLH, maxa, nterms) 
INTEGER  ICOLH(l) ,maxa (1) 

ISKIP-1 

IF (NEQ-2* (NEQ/2) .EQ.0)  ISKIP-2 
DO  201  J-ISKIP+1, NEQ, 2 
IDIF-ICOLH ( J+1) -ICOLH ( J) 

IF(IDIF.LT.l)  THEN 
ICOLH ( J+1) -ICOLH ( J) +1 
ELSE 

IF (IDIF . GT . 1 ) THEN 
ICOLH ( J) -ICOLH (J+1 ) -1 
ENDIF 
ENDIF 

201  CONTINUE 

do  20  i-l,neq+l 
20  maxa(i)-0 

maxa (1) -1 
maxa (2 ) =2 
do  10  i-2,neq 

10  maxa (i+l)*maxa (i) +icolh(i) +1 

nterms-maxa (neq+1)  -1 
RETURN 
END 
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Forcesub  S0R1 (N, NTERMS , A, B, X, C , CC, MAXA, NBW, TOL, MAXNIT, W, ICOLH) 
& of  NP  ident  ME 

DOUBLE  PRECISION  A ( 1 ) , B ( 1 ) , X ( 1 ) , CC ( 1 ) , TOL, W 
DOUBLE  PRECISION  C(l) 

Shared  DOUBLE  PRECISION  THEMAX, THENOR 
INTEGER  MAXA ( 1 ) , ICOLH (1) ,N, I SOLVE, NBW, MAXNIT 
Shared  LOGICAL  TYPE3 
Shared  LOGICAL  TYPE4 
Shared  LOGICAL  TYPE1 
Shared  LOGICAL  TYPE2 

Shared  INTEGER  MSTAGL, MENDGL, IGO, NROL,  ISKIP 
Private  INTEGER  MS TART, MEND 

Private  DOUBLE  PRECISION  TEMP P, SUM1, SUM2, XTEMP, TEMP 
End  declarations 
Barrier 

write{6,*)  'first  thing  in  SOR' 

WRITE ( 6 , * ) ' MAXA ( I ) = ',  (MAXA ( I ) , 1=1 , N+l ) 

WRITE ( 6 , * ) 'ICOLH (I)-  ',  ( ICOLH ( I ) , 1=1 , N) 

WRITE ( 6 , * ) ' A (NTERMS) “ ',  ( A ( I ) , 1=1, MAXA (N+l) -1) 

WRITE ( 6 , * ) ' B (NEQ) = ' , (B(I),I=1,N) 

End  barrier 
ISKIP  = 1 

IF  ( N-2  * (N/2)  .EQ.  0 ) ISKIP  = 2 

DO  100  ICONT  = 1, MAXNIT 

Barrier 
End  barrier 

Presched  do  11  JCONT  = 1,NP 
DO  10  I = 1 , N 
C(I)  = 0.0 

CONTINUE 

1 End  presched  do 

Presched  do  12  I = 1,N 
CC(I)  = 0.0 

2 End  presched  do 
Barrier 

IF  (ISKIP  .EQ.  2 ) THEN 

IF  (ICOLH (2)  .EQ.  1 ) THEN 
C(l)  = X ( 2 ) * A (3 ) 

END  IF 
END  IF 

End  barrier 

****************  PRESCHED  DO  LOOP  *********** 
Presched  do  30  I = ISKIP+l,NROL, 2 
Presched  do  30  I ■ ISKIP+1  , N,  2 
C(I)  = C(I)  + X(I+1)  * A (MAXA ( 1+1 ) +1 ) 

DO  20  J = I - ICOLH (I)  ,1-1 
C C(J)-C(J)  + X(I) *A(MAXA(I)+I-J) 

C(J)=C(J)  + X(I) *A(MAXA(I)+I-J)  + X(I+1)  * A (MAXA ( 1+1 ) +1+1- J) 

20  CONTINUE 

30  End  presched  do 


Critical  TYPE1 
XTEMP  =0.0 
TEMPP  =0.0 
DO  29  I = 1, N 
CC(I)  = C(I)  + CC(I) 
29  CONTINUE 

End  critical 


Barrier 


TEMP  - X(l) 

X(l)  =W* ( ( B ( 1 ) - CC(1) )/A(MAXA(l) ) ) + (1-W)  * X(l) 

C THEMAX  - ABS (TEMP  - X(l)) 

XTEMP  = {(TEMP  - X ( 1 ) ) **2 ) 

TEMPP  - X(l) **2 
THEMAX  =0.0 
THENOR  =0.0 
End  barrier 

Presched  do  50  K = 2,N 
C(K)  = B(K)  - CC (K) 

DO  40  J = K - ICOLH(K)  ,K-1 
40  C (K)  = C (K)  - A (MAXA (K)  + K - J)  * X(J) 

TEMP  = X (K) 

X (K)  = W*(  C(K)  / A (MAXA (K) ) ) + (1  - W ) * X(K) 

C TEMPP  = ABS  (X  (K)  - TEMP  ) 

C XTEMP  = MAX  ( TEMPP, XTEMP  ) 

XTEMP  = XTEMP  + ((X(K)  - TEMP) **2) 

TEMPP  = TEMPP  + (X (K) **2) 

50  End  presched  do 

Critical  TYPE2 
THEMAX  = THEMAX  + XTEMP 
THENOR  = THENOR  + TEMPP 
End  critical 

Barrier 

THEMAX  - SORT  (THEMAX) 

C THEMAX  = SQRT  (THEMAX)  / SQRT (THENOR) 

End  barrier 

C write  (6,*)'  themax  tol  ',themax,tol 

IF  ( THEMAX  .LT.  TOL  ) GO  TO  110 
100  CONTINUE 

110  CONTINUE 

Barrier 

WRITE (6,*)'  NUMBER  OF  ITTERATIONS  IN  GSM  = ' , ICONT 
C DO  7 9 I = 1 , 6 

C WRITE (6, 78 ) X ( 1 ) , X (2 ) , X (3 ) , X ( 4 ) , X ( 5) , X (6) 

78  FORMAT (2X, ' S . O . R =' , 6E11 . 4 ) 

End  Barrier 

RETURN 

END 
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ABSTRACT 


The  computer  program  SAP  IV  for  the  static  and  dynamic  analysis 
of  linear  structural  systems  is  presented. 

The  report  is  divided  into  three  parts.  In  the  first  part  the 
reader  is  introduced  to  the  logical  construction  of  the  program,  the 
dynamic  high  speed  storage  allocation,  the  analysis  capabilities,  the 
finite  element  library  and  the  numerical  techniques  used.  Typical 
running  times  are  given.  In  the  second  part  of  the  report  several 
sample  analyses  are  described.  These  problems  have  been  selected  as 
standard  problems  whose  solutions  are  provided  with  the  program.  In 
the  last  part  of  the  report  the  user's  manual  of  the  program  is  given. 
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- PART  A - 

DESCRIPTION  OF  SAP  IV 


1.  INTRODUCTION 


The  development  of  an  effective  computer  program  for  structural 
analysis  requires  a knowledge  of  three  scientific  disciplines  — 
structural  mechanics,  numerical  analysis  and  computer  application. 

The  development  of  accurate  and  efficient  structural  elements  requires 
a modern  background  in  structural  mechanics.  The  efficiency  of  a 
program  depends  largely  on  the  numerical  techniques  employed  and  on 
their  effective  computer  implementation.  With  regard  to  programming 
techniques,  an  optimum  allocation  of  high  and  low  speed  storage  is 
necessary . 

A most  important  aspect  of  a general  purpose  computer  program 
is,  however,  the  ease  with  which  it  can  be  modified,  extended  and  up- 
dated ; otherwise,  it  may  very  well  be  that  the  program  is  obsolete 
within  a few  years  after  completion.  This  is  because  new  structural 
elements  are  developed,  better  numerical  procedures  are  available,  or 
new  computer  equipment  which  requires  new  coding  techniques  is  produced. 

The  structural  analysis  program  SAP  was  designed  to  be  modified 
and  extended  by  the  user.  Additional  options  and  new  elements  may 
easily  be  added.  The  program  has  the  capacity  to  analyze  very  large 
three-dimensional  systems;  however,  there  is  no  loss  in  efficiency 
in  the  solution  of  smaller  problems.  Also,  from  the  complete  program, 
smaller  special  purpose  programs  can  easily  be  assembled  by  simply 
using  only  those  subroutines  which  are  actually  needed  in  the  execu- 
tion. This  makes  the  program  particularly  usable  on  small  size 


computers . 


The  current  program  version  SAP  IV  for  the  static  and  dynamic  analysis 
of  linear  structural  systems  is  the  result  of  several  years'  research  and 
development  experience.  The  program  has  proven  to  be  a very  flexible  and 
efficient  analysis  tool.  The  program  is  coded  in  FORTRAN  IV  and  operates 
without  modifications  on  the  CDC  6400,  6600  and  7600  computers.  The  first 
version  of  program  SAP  was  published  in  September  1970  [28].  An  improved 
static  analysis  program,  namely  SOLID  SAP,  or  SAP  II,  was  presented  in  1971 
[29].  Work  was  then  started  on  a new  static  and  dynamic  analysis  program. 
The  program  SAP  III  for  static  and  dynamic  analysis  was  released  towards 
the  end  of  1972,  but  only  to  those  agencies  which  supported  our  research. 

In  relation  to  SAP  III,  the  current  version  SAP  IV  has  improvements 
throughout,  and  in  particular  has  available  a new  variable-number-nodes 
thick  shell  and  three-dimensional  element,  and  out-of-core  direct 
integration  for  time  history  analysis. 

The  structural  systems  to  be  analyzed  may  be  composed  of  combinations 
of  a number  of  different  structural  elements.  The  program  presently 
contains  the  following  element  types; 

(a)  three-dimensional  truss  element, 

(b)  three-dimensional  beam  element, 

(c)  plane  stress  and  plane  strain  element, 

(d)  two-dimensional  axisymmetric  solid, 

(e)  three-dimensional  solid, 

(f)  variable-number-nodes  thick  shell  and  three-dimensional  element, 

(g)  thin  plate  or  thin  shell  element, 

(h)  boundary  element, 

(i)  pipe  element  (tangent  and  bend). 
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These  structural  elements  can  be  used  in  a static  or  dynamic  analysis. 
The  capacity  of  the  program  depends  mainly  on  the  total  number  of  nodal 
points  in  the  system,  the  number  of  eigenvalues  needed  in  the  dynamic 
analysis  and  the  computer  used.  There  is  practically  no  restriction 
on  the  number  of  elements  used,  the  number  of  load  cases  or  the  order 
and  bandwidth  of  the  stiffness  matrix.  Each  nodal  point  in  the  system 
can  have  from  zero  to  six  displacement  degrees  of  freedom.  The  element 
stiffness  and  mass  matrices  are  assembled  in  condensed  form;  therefore, 
the  program  is  equally  efficient  in  the  analysis  of  one-,  two-  or  three- 
dimensional  systems . 

The  formation  of  the  structure  matrices  is  carried  out  in  the  same 
way  in  a static  or  dynamic  analysis.  The  static  analysis  is  continued 
by  solving  the  equations  of  equilibrium  followed  by  the  computation  of 
element  stresses.  In  a dynamic  analysis  the  choice  is  between 

1.  frequency  calculations  only, 

2.  frequency  calculations  followed  by  response  history  analysis, 

3.  frequency  calculations  followed  by  response  spectrum  analysis, 

4.  response  history  analysis  by  direct  integration. 

To  obtain  the  frequencies  and  vibration  mode  shapes  solution  routines 
are  used  which  calculate  the  required  eigenvalues  and  eigenvectors 
directly  without  a transformation  of  the  structure  stiffness  matrix  and 
mass  matrix  to  a reduced  form.  In  the  direct  integration  an  uncondi- 
tionally stable  integration  scheme  is  used,  which  also  operates  on 
the  original  structure  stiffness  matrix  and  mass  matrix.  This  way  the 
program  operation  and  necessary  input  data  for  a dynamic  analysis  is 
a simple  addition  to  what  is  needed  for  a static  analysis. 
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The  purpose  in  this  part  of  the  report  is  to  present  briefly  the 
general  program  organization,  the  current  element  library  and  the 
numerical  techniques  used . The  different  options  available  for  static 
and  dynamic  analyses  are  described  and  typical  running  times  are 
given.  In  the  presentation,  emphasis  is  directed  to  the  practical 
aspects  of  the  program.  For  information  on  the  development  of  the 
structural  elements  and  the  numerical  techniques  used  the  reader  is 
referred  to  appropriate  references. 
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2.  THE  EQUILIBRIUM  EQUATIONS  FOR  COMPLEX  STRUCTURAL  SYSTEMS 


2.1  Element  to  Structure  Matrices 

The  nodal  point  equilibrium  equations  for  a 1 inear  system  of  structural 
elements  can  be  derived  by  several  different  approaches  [1]  [2]  [9]  [ 15] 
[23]  134].  All  methods  yield  a set  of  linear  equations  of  the  following 
form 

M u + C u + K u = R (1) 

where  M is  the  mass  matrix,  C is  the  damping  matrix  and  K is  the  stiff- 
ness matrix  of  the  element  assemblage;  the  vectors  u,  u,  u and  R are 
the  nodal  d isplacements , velocities,  accelerations  and  generalized  loads, 
respectively.  The  structure  matrices  are  formed  by  direct  addition 
of  the  element  matrices ; for  example 


where  K is  the  stiffness  matrix  of  the  m’th  element.  Although  K 
m m 

is  formally  of  the  same  order  as  K,  only  those  terms  in  which  pertain 
to  the  element  degrees  of  freedom  are  nonzero.  The  addition  of  the 
element  matrices  can  therefore  be  performed  by  using  the  element  matrices 
in  compact  form  together  with  identification  arrays  which  relate  element 
to  structure  degrees  of  freedom.  The  algorithm  used  in  the  program  is 
described  in  Section  3.3. 

In  the  program  the  structure  stiffness  matrix  and  a diagonal  mass 
matrix  are  assembled.  Therefore,  a lumped  mass  analysis  is  assumed, 
where  the  structure  mass  is  the  sum  of  the  individual  element  mass 
matrices  plus  additional  concentrated  masses  which  are  specified  at 
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selected  degrees  of  freedom.  The  damping  is  assumed  to  be  proportional 
and  is  specified  in  form  of  a modal  damping  factor.  The  assumptions 
used  in  lumped  mass  analyses  and  in  the  use  of  proportional  damping  have 
been  discussed  at  various  occasions  [9]  [ll]  [17]  [33]. 

2.2  Boundary  Conditions 

If  a displacement  component  is  zero,  the  corresponding  equation 
is  not  retained  in  the  structure  equilibrium  equations,  Eq . (1),  and 
the  corresponding  element  stiffness  and  mass  terms  are  disregarded. 

If  a non-zero  displacement  is  to  be  specified  at  a degree  of  freedom  i, 
say  = x,  the  equation 

kUi  =kx  (3) 

is  added  into  Eq . (1),  where  k »k..  . Therefore,  the  solution  of 

Q.  (1)  must  give  u^  - x.  Physically,  this  can  be  interpreted  as 
adding  at  the  degree  of  freedom  "i"  a spring  of  large  stiffness  k and 
specifying  a load  which,  because  of  the  relatively  flexible  structure 
at  this  degree  of  freedom,  produces  the  required  displacement  x. 
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3,  PROGRAM  ORGANIZATION  FOR  CALCULATION  OF  THE 
STRUCTURE  STIFFNESS  MATRIX  AND  MASS  MATRIX 


The  calculation  of  the  structure  stiffness  matrix  and  mass  matrix  is 
accomplished  in  three  distinct  phases: 

1.  The  nodal  point  input  data  is  read  and  generated  by  the  Drogram. 

In  this  phase  the  equation  numbers  for  the  active  degrees  of 
freedom  at  each  nodal  point  are  established. 

2.  The  element  stiffness  and  mass  matrices  are  calculated  together 
with  their  connection  arrays;  the  arrays  are  stored  in  sequence  on 
tape  (or  other  low-speed  storage) . 

3.  The  structure  stiffness  matrix  and  mass  matrix  are  formed  by 
addition  of  the  element  matrices  and  stored  in  block  form  on  tape. 

It  need  be  noted  that  these  basic  steps  are  independent  of  the 
element  type  used  and  are  the  same  for  either  a static  or  dynamic 
analysis . 

3.1  Nodal  Point  Input  Data  and  Degrees  of  Freedom 

The  capacity  of  the  program  is  controlled  by  the  number  of  nodal 
points  of  the  structural  system.  For  each  nodal  point  six  boundary 
condition  codes  (stored  in  the  arra>  ID)  , three  coordinates  (stored 
in  the  arrays  X,Y,Z)  and  the  nodal  point  temperatures  (stored  in  the  array 
T)  are  required  (generation  capability  is  provided).  All  nodal  point  data 
is  retained  in  high  speed  storage  during  the  formation  of  the  element 
stiffness  and  mass  matrices.  Since  the  required  high  speed  storage 
for  the  element  subroutines  is  relatively  small,  the  minimum  required 
storage  for  a given  problem  is  a little  larger  than  ten  times  the 
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number  of  nodal  points  in  the  system. 

It  need  be  noted  that  the  user  should  allow  only  those  degrees 
of  freedom  which  are  compatible  with  the  elements  connected  to  a nodal 
noint.  The  program  always  deals  with  six  possible  degrees  of  freedom 
at  each  nodal  point,  and  all  non-active  degrees  of  freedom  should  be 
deleted, so  as  to  decrease  the  order  of  the  structure  matrices.  Speci- 
fically, a "l"  in  the  ID  array  denotes  that  no  equation  shall  be  associ- 
ated with  the  degree  of  freedom,  whereas  a "o"  indicates  that  this  is 
an  active  degree  of  freedom.  Figure  1 shows  for  the  simple  truss 
structure  the  ID  array  as  it  was  read  and/or  generated  by  the  program. 
Once  the  complete  ID  and  X,Y,Z  arrays  have  been  obtained,  equation 
numbers  are  associated  with  all  active  degrees  of  freedom,  i.e.,  the 
zeroes  in  the  ID  array  are  replaced  by  corresponding  equation  numbers, 
and  each  one  is  replaced  by  a zero,  as  shown  in  Fig.  2 for  the  simple 
truss  example. 

3.2  Element  Mass  and  Stiffness  Calculations 

With  the  coordinates  of  all  nodal  points  known  and  the  equation 
numbers  of  the  degrees  of  freedom  having  been  established,  the  stiff- 
ness, mass  and  stress-displacement  transformation  matrices  for  each 
structural  element  in  the  system  are  calculated.  As  pointed  out 
earlier,  little  additional  high-speed  storage  is  required  for  this 
phase  since  these  matrices  are  formed  and  placed  on  tape  storage  at 
the  same  time  as  the  element  properties  are  read.  Together  with  the 
matrices  pertaining  to  the  element,  the  corresponding  element  connec- 
tion array  , vector  LM  , is  written  on  tape.  The  vector  LM  is  established 
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FIGURE  1:  NODAL  POINT  LAYOUT  OF  TRUSS-EXAMPLE 
AND  ID-ARRAY  AS  READ  AND/OR 
GENERATED 
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FIGURE  2:  ID  ARRAY  OF  TRUSS-EXAMPLE  AFTER 
ALLOCATION  OF  EQUATION  NUMBERS  TO 
ACTIVE  DEGREES  OF  FREEDOM 


FIGURE  3:  CONNECTION  ARRAY  (VECTOR  LM)  FOR  A 

TYPICAL  ELEMENT  OF  THE  TRUSS-EXAMPLE 
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from  the  ID  matrix  and  the  specified  structure  nodal  points  pertaining 
to  the  element.  The  connection  array  for  a typical  element  of  the 
truss  element  is  shown  in  Fig.  3. 

The  element  matrices  are  calculated  in  groups,  i.e.,  always  all 
elements  in  one  group  together,  thus  calling  the  corresponding  element 
subroutine  only  once  for  each  element  group.  After  all  element  matrices 
have  been  established,  the  ID  and  X,Y,Z  arrays  are  not  needed_any_more , 
and  the  corresponding  storage  area  is  use.d_Xo prma t n__of^_th.e 
s t rue t u re  matrices  a nd_  lat er  . f o r .th.e — solution  Qf„the_equation s f 
equilibrium. 

3,3  Formation  of  Structure  Stiffness  and  Mass 

The  stiffness  matrix  and  mass  matrix  of  the  structure  are  formed 

in  blocks,  as  shown  in  Fig.  4 for  the  truss-example.  The  number  of 

equations  per  block  depends  on  the  available  high  speed  storage  and 

is  calculated  in  the  program  as  indicated  in  Fig.  5.  It  is  noted 

that  on  reasonable  size  computers  very  large  systems  can  be  analyzed 

for  static  and  dynamic  response.  With  the  number  of  equations  per 

block  known,  the  stiffness  and  mass  matrix  are  assembled  two  blocks  at 

a time  by  direct  addition  of  the  element  matrices.  In  this  process 

it  is  necessary  to  pass  through  the  element  matrices  which  are  stored 

on  tape.  In  order  to  minimizg_tape  reading,  in  eachpa  ss^fiJLeinen t ") 

matrices  which  pertain  to  the  next  several Jblpcks  are_juctt-ten  on 

another .tape.  This  way  the  tape  reading  necessary  for  the  formation 

— J 

o f t he  se  . b locks  i s r educ ed~signi£ic an  1 1 yrr- 

A flow  diagram  of  the  program  organization  for  the  calculation  of 
the  structure  stiffness  matrix  and  mass  matrix  is  shown  in  Fig.  6. 
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FIGURE  4:  STORAGE  OF  STIFFNESS  MATRIX  AND 
MASS  MATRIX  ON  TAPE 


USING  AVAILABLE  NUMBER  OF  HIGH  SPEED  STORAGE  LOCATIONS 
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FIGURE  5:  FLOWCHART  SHOWING  CALCULATION  OF 
NUMBER  OF  EQUATIONS  IN  A BLOCK 


START 


CONTINUE  TO  STATIC 


OR  DYNAMIC  ANALYSIS 

FIGURE  6:  FLOWCHART  FOR  CALCULATION  OF 

STRUCTURE  STIFFNESS  MATRIX  AND  MASS 
MATRIX 
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With  the  matrices  stored  in  block  form  on  tape  either  a static 
dynamic  analysis  can  now  be  carried  out. 


or  a 
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4.  THE  ELEMENT  LIBRARY 


The  element  1 ibrary  of  SAP  IV  consists  of  eight  different  element 
types.  These  elements  can  be  used  in  either  a static  or  dynamic 
analysis.  They  are  shown  in  Fig.  7 and  are  briefly  described  below, 

4.1  Three  Dimensional  Truss  Element 

The  derivation  of  the  truss  element  stiffness  is  given  in  Refs. 
[ 231  \ 291  . The  element  can  be  subjected  to  a uniform  temperature 
change . 


/ 

/ 


4,2  Three-Dimensional  Beam  Element 

The  beam  element  included  in  the  program  considers  torsion, 
bending  about  two  axes,  axial  and  shearing  deformations.  The  element 
is  prismatic.  The  development  of  its  stiffness  properties  is  standard 
and  is  given  in  Ref.  L 23] , Inertia  loading  in  three  directions  and 
specified  fixed-end- forces  form  the  element  load  cases.  Forces  (axial 
and  shear)  and  moments  (bending  and  torsion)  are  calculated  in  the 
beam  local  co-ordinate  system.  _____ 


A typical  beam  element  is  shown  in  Fig.  7b.  A plane  which  defines 
the  principal  bending  axis  of  the  beam  is  specified  by  the  plane  i,  j,  k.  j 


Only  the  geometry  of  nodal  point  k is  needed;  therefore,  no  additional 
degrees  of  freedom  for  nodal  point  k are  used  in  the  computer  program. 

A unique  option  of  the  beam  member  is  that  the  ends  of  the  beam  can 
be  geometrically  constrained  to  a master  node.  Slave  degrees  of 
freedom  at  the  end  of  the  beam  are  eliminated  from  the  formulation 
and  replaced  by  the  transformed  degrees  of  freedom  of  the  master  node 
[l8]  [ 29],  This  technique  reduces  the  total  number  of  joint  equilibrium 
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b.  THREE-DIMENSIONAL 
BEAM  ELEMENT 


c. PLANE  STRESS, PLANE  STRAIN  AND  AXISYMMETRIC  ELEMENTS 


dTHREE-DIMENSIONAL 

SOLID 


e.  VARIABLE-NUMBER  - NODES 
THICK  SHELL  AND 
THREE-DIMENSIONAL  ELEMENT 


f.THIN  SHELL  AND  BOUNDARY 


g.  PIPE  ELEMENT 

FIGURE  7:  ELEMENT 


LIBRARY  OF  SAP  IV 
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equations  in  the  system  (while  possibly  increasing  the  bandwidth)  and 
greatly  reduces  the  possibility  of  numerical  sensitivities  in  many 
types  of  structures.  Also,  the  method  can  be  used  to  specify  rigid 
floor  diaphragms  in  building  analysis. 

4.3  Plane  Stress,  Plane  Strain  and  Axisymmetrlc  Elements 

A plane  stress  quadrilateral  (or  triangular)  element  with  ortho- 
tropic  material  properties  is  available.  Each  plane  stress  element 
may  be  of  different  thickness  and  may  be  located  in  an  arbitrary  plane 
with  respect  to  the  three-dimensional  coordinate  system.  The  plane 
strain  and  axisymmetric  elements  are  restricted  to  the  y-z  plane. 
Gravity,  inertia  and  temperature  loadings  may  be  considered.  Stresses 
may  be  computed  at  the  center  of  the  element  and  at  the  center  of  each 
side.  The  element  is  based  on  an  isoparametric  formulation  [19]  [34]. 

Incompatible  displacement  modes  can  be  included  in  order  to  improve 
the  bending  properties  of  the  element  [26]  [29]  [32]. 

4.4  Three-Dimensional  Solid  Element 

A general  eight  nodal  point  "brick"  element,  with  three  transla- 
tional degrees  of  freedom  per  nodal  point  can  be  used,  Fig.  7d.  Isotro- 
pic material  properties  are  assumed  and  element  loading  consists  of 
temperature,  surface  pressure  and  inertia  loads  in  three  directions. 
Stresses  (six  components)  may  be  computed  at  the  center  of  the  element 
and  at  the  center  of  each  face.  The  element  employs  incompatible  modes, 
which  can  be  very  effective  if  rectangular  elements  are  used  [26], 

4.5  Variable-Number-Nodes  Thick  Shell  and  Three-Dimensional  Element 

A general  three-dimensional  isoparametric  or  subparametric  element 
which  may  have  from  8 to  21  nodes  can  be  used  for  three-dimensional 
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or  thick  shell  analysis,  Fig.  7e  [7]  [8].  General  orthotropic 

material  properties  can  be  assigned  to  the  element.  The  loading  may 
consist  of  applied  surface  pressure,  hydrostatic  loads,  inertia  loads 
in  three  directions,  and  thermal  loads.  Six  global  stresses  are 
output  at  up  to  seven  locations  within  an  element. 

4 #6  Thin  Plate  and  Shell  Element 

The  thin  shell  element  available  in  the  program  is  a quadrilateral 
of  arbitrary  geometry  formed  from  four  compatible  triangles.  The 
bending  and  plane  stress  properties  of  the  element  are  described  in 
references  [ 12 ] [14].  The  shell  element  uses  the  constant  strain 
triangle  and  the  LCCT9  element  to  represent  the  membrane  and  bending 
behavior,  respectively.  The  central  node  is  located  at  the  average  of 
the  coordinates  of  the  four  corner  nodes.  The  element  has  six  interior 
degrees  of  freedom  which  are  eliminated  at  the  element  level  prior 
to  assembly;  therefore,  the  resulting  quadrilateral  element  has  twenty- 
four  degrees  of  freedom,  i.e.,  six  degrees  of  freedom  per  node  in  the 

global  coordinate  system. 

In  the  analysis  of  flat  plates  the  stiffness  associated  with  the 
rotation  normal  to  the  shell  surface  is  not  defined;  therefore,  the 
rotation  normal  degree  of  freedom  must  not  be  included  in  the  analysis. 
For  curved  shells,  the  normal  rotation  need  be  included  as  an  extra 
degree  of  freedom.  In  case  the  curvature  is  very  small,  the  degree 
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of  freedo.  should  be  restra.ned  by  the  addition  of  a "Boundary  Element” 
with  a small  normal  rotational  stiffness,  say  of  loss  or  about  lot  of 
the  element  bending  stiffness  [ 13 J [34). 

4.7  Boundary  Element 

The  boundary  element,  shown  in  Fig.  7f,  can  be  used  for  the 
following : 

1.  in  the  idealization  of  an  external  elastic  support  at  a node; 

2.  in  the  idealization  of  an  inclined  roller  support; 

3.  to  specify  a displacement,  or 

4.  to  eliminate  the  numerical  difficulty  associated  with  the 

'sixth'  degree  of  freedom  in  the  analysis  of  nearly  flat 
shells. 

The  element  is  one-dimensional  with  an  axial  or  torsional  stiffness. 

The  element  stiffness  coefficients  are  added  directly  to  the  total 
stiffness  matrix  (see  Section  2.2). 

4.8  Pipe  Element 
; “ 

The  pipe  element  (Fig.  7g)  can  represent  a straight  segment 
(tangent)  or  a circularly  curved  segment  (bend);  both  elements  require 
a uniform  section  and  uniform  material  properties.  Elements  can  be 
directed  arbitrarily  in  space.  The  member  stiffness  matrices  account 
for  bending,  torsional,  axial  and  shearing  deformations.  In  addition, 

the  effect  of  internal  pressure  on  the  stiffness  of  curved  pipe  elements 
is  considered. 

The  types  of  structure  loads  contributed  by  the  pipe  elements 
include  gravity  loading  in  the  global  directions,  and  loads  due  to  thermal 
distortions  and  deformations  induced  by  internal  pressure.  Forces  and  moments 
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acting  at  the  member  ends  (i,j)  and  at  the  center  of  each  bend  are 
calculated  in  coordinate  systems  aligned  with  the  member’s  cross 
section . 

The  pipe  element  stiffness  matrix  is  formed  by  first  evaluating 
the  flexibility  matrix  corresponding  to  the  six  degrees  of  freedom  at 
end  j as  given  by  Poley  [22].  With  the  corresponding  stiffness  matrix, 
the  equilibrium  transformations  outlined  by  Hall  et  al  [16]  are  used 
to  form  the  complete  element  stiffness  matrix.  Distortions  due  to 
element  loads  are  premultiplied  by  the  stiffness  matrix  to  compute 
restrained  nodal  forces  due  to  thermal,  pressure  or  gravity  loads. 
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5.  STATIC  ANALYSIS 


A static  analysis  involves  the  solution  of  the  equilibrium 
equations 

K u = R (4 ) 

followed  by  the  calculation  of  element  stresses. 

5.1  Solution  of  Equilibrium  Equations 

The  load  vectors  R have  been  assembled  at  the  same  time  as  the 

structure  stiffness  matrix  and  mass  matrix  were  formed.  The  solution 

of  the  equations  is  obtained  using  the  large  capacity  linear  equation 

solver  SESOL  [31],  This  subroutine  uses  Gauss  elimination  on  the 

positive-definite  symmetrical  system  of  equations.  The  algorithm 

performs  a minimum  number  of  operations;  i.e.  there  are  no  operations 

T 

with  zero  elements.  In  the  program,  the  L DL  decomposition  of  K is 
used,  hence  Eq . (4)  can  be  written  as 

LTv  = R (5) 

and 

v = DLu  (6) 

where  the  solution  for  v in  Eq.  (5)  is  obtained  by  a reduction  of  the 
load  vectors;  the  displacement  vectors  u are  then  calculated  by  a 
back-subst it ut ion . 

In  the  solution,  the  load  vectors  are  reduced  at  the  same  time  as 
K is  decomposed.  In  all  operations  it  is  necessary  to  have  at  any  one 
time  the  required  matrix  elements  in  high-speed  storage.  In  the 


reduction,  two  blocks  are  in  high  speed  storage  (as  was  also  the  case 
in  the  fom.ation  of  the  stiffness  matrix  and  ir.ass  ir.at riy^  , i . e . , the 
"leading"  block,  which  finally  stores  the  elements  of  L and  D,  and  in 
succession  those  blocks  which  are  affected  by  the  decomposition  of  the 
"leading"  block.  Table  1 gives  some  typical  solution  times. 

5.2  Evaluation  of  Element  Stresses 

After  the  nodal  point  displacements  have  been  evaluated,  sequen- 
tually  the  element  stress-displacement  matrices  are  read  from  low 
speed  storage  and  the  element  stresses  are  calculated. 
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6.  CALCULATION  OF  FREQUENCIES  AND  MODE  SHAPES 


The  dynamic  analysis  of  a structural  system  using  mode  super- 
position requires  as  the  first  step  the  solution  of  the  generalized 
eigenvalue  problem 

2 

K <t>  = (U  M <t>  (7) 

where  <ju  and  <t>  are  free  vibration  frequency  and  mode  shape,  respectively. 
As  was  described  in  Section  3.3  the  program  stores  the  stiffness  and 
mass  matrix  in  blocks  on  tape,  Fig.  4.  The  mass  matrix  is  diagonal 
with  partly  zero  diagonal  elements.  The  program  assumes  that  only 
the  lowest  p eigenvalues  and  corresponding  eigenvectors  are  needed. 

The  solution  of  Eq . (7)  can  therefore  be  written  as 

2 

* K $ = M 4>fi  (8) 

2 

where  Q is  a diagonal  matrix  with  the  p smallest  eigenvalues, 

i.e.  C?  = diag(u^),  and  $ stores  the  corresponding  M-orthonormal ized 

eigenvectors  4>  , <t>  f . . . < t>  . Two  different  solution  procedures  are 
i Z p 

used  in  the  program  , a determinant  search  technique  or  a subspace 
iteration  solution.  The  determinant  search  solution  is  carried  out 
when  the  stiffness  matrix  can  be  contained  in  high-speed  storage  in 
one  block.  Therefore,  for  systems  of  large  order  and  bandwidth  the 
subspace  iteration  method  is  used.  Both  solution  techniques  solve 
the  generalized  eigenvalue  Droblem  directly  without  a transformation 
to  the  standard  form  [3] . 
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6.1  The  Determinant  Search  Solution 


The  determinant  search  technique  is  best  suited  for  the  analysis 

of  large  systems  in  which  K and  M have  small  bandwidths  [4]  . Basically, 

the  solution  algorithm  combines  triangular  factorization  and  vector 

inverse  iteration  in  an  optimum  manner  to  calculate  the  required 

eigenvalues  and  eigenvectors;  these  are  obtained  in  sequence  starting 

2 

from  the  least  dominant  eigenpair  u.^  , . An  efficient  accelerated 

secant  iteration  procedure  which  operates  on  the  characteristic 
polynomial 

p(au2)  = det(K  - u;2M)  (9) 

is  used  to  obtain  a shift  near  the  next  unknown  eigenvalue.  The  eigen- 
value separation  theorem  (Sturm  sequence  property)  is  used  in  this 

iteration.  Each  determinant  evaluation  requires  a triangular  factoriza- 

2 

tion  of  the  matrix  K - <ju  M . Once  a shift  near  the  unknown  eigenvalue 
has  been  obtained,  inverse  iteration  is  used  to  calculate  the  eigen- 
vector; the  eigenvalue  is  obtained  by  adding  the  Rayleigh  quotient 
correction  to  the  shift  value.  Table  2 shows  typical  solution  times. 

6.2  The  Subspace  Iteration  Solution 

When  the  system  is  too  large  to  be  completely  contained  in  high 
speed  storage,  i.e.  more  blocks  than  one  are  used,  the  subspace  iteration 
solution  is  carried  out.  The  iteration  can  be  interpreted  as  a re- 
peated application  of  the  Ritz  method  [5]  I 9] , in  which  the  computed 
eigenvectors  from  one  step  are  used  as  the  trial  basis  vectors  for  the 
next  iteration  until  convergence  to  the  required  p eigenvalues  and 
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eigenvectors  is  obtained. 

The  solution  is  carried  out  by  iterating  simultaneously  with  q 
linearly  independent  vectors,  where  q >p.  In  the  k'th  iteration 
the  vectors  span  the  q-dimens iona 1 subspace  £k  and  ’best’  eigenvalue 
and  eigenvector  approximations  are  calculated;  i.e.  when  the  vectors 
span  the  p-dimens ional  least  dominant  subspace,  the  required  eigen- 
values and  eigenvectors  are  obtained. 

Let  store  the  starting  vectors,  then  the  k’th  iteration  is 
described  as  follows: 

Solve  for  vectors  V which  span  £ 

k k 


KVk  - M Vi 


(10) 


Calculate  the  projections  of  K and  M onto  t (i.e.  the  generalized 

K 

stiffness  matrix  and  mass  matrix  corresponding  to  & ) 

k 


kk = k vk 


(id 


M,  = MV, 
k k k 


(12) 


Solve  for  the  eigensystem  of  and 


\ 4 


(13) 


and  calculate  the  k’th  improved  approximation  to  the  eigenvectors 


V = V Q 
k k k 


(14) 
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Provided  that  the  starting  subspace  is  not  orthogonal  to  any  of  the 


required  eigenvectors!  the  iteration  converges  to  the  desired  result, 
and  -4  $ as  k *4  <x>  # 

The  number  of  vectors  q used  in  the  iteration  is  taken  greater 
than  the  desired  number  of  eigenvectors  in  order  to  accelerate  the 
convergence  of  the  process.  The  number  of  iterations  required  to 
achieve  satisfactory  convergence  depends,  of  course,  on  the  quality  of 
the  starting  vectors  V . Unless  requested  otherwise  (see  Section  6.3), 
the  program  generates  q starting  vectors  where  q = min(2p,  p+8),  which 
has  proven  to  be  effective  in  general  applications.  At  conver- 
gence a Sturm  sequence  check  can  be  requested  to  verify  that  the  lowest 
p eigenvalues  have  been  found. 

Table  3 lists  a few  typical  solution  times  using  the  program  generated 
starting  vectors. 


6.3  Dynamic  Optimization 

The  solution  of  the  eigenvalue  problem  may  be  required  when  a 
good  estimate  of  the  required  eigensystem  is  already  known,  such  as 
in  dynamic  optimization.  In  this  case  the  subspace  iteration  method 
is  ideally  suited  for  solution.  The  number  of  iteration  vectors  q 
and  the  vectors  Vq  together  with  the  maximum  number  of  iterations  can 
in  this  case  be  specified  by  the  user.  Also,  in  case  the  number  of 
eigenvalues  and  vectors  required  is  increased,  the  already  calculated 
eigenvectors  can  be  specified  as  part  of  the  starting  iteration  vectors 
in  order  to  accelerate  convergence. 
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TABLE  3 CALCULATION  OF  FREQUENCIES  AND  MODE  SHAPES 
USING  SUBSPACE  ITERATION  METHOD 


FRAME 


7.  DYNAMIC  ANALYSES 


In  dynamic  response  analysis  the  solution  of  the  equations 

Mu  + Cu  + Ku  = R (t ) (15) 


is  required,  where  R(t)  can  be  a vector  of  arbitrary  time  varying  loads 
or  of  effective  loads  which  result  from  ground  motion.  Specifically, 
in  the  case  of  ground  motion,  if  it  is  assumed  that  the  structure  is 
uniformly  subjected  to  the  ground  acceleration  u [9  ] , the  equilibrium 
equations  considered  are 

Mu  + C u + Ku  = - Mu  (16) 

r r r g 


where  u is  the  relative  displacement  of  the  structure  with  respect 
r 

to  the  ground,  i.e.  u - u - u . 

^ r g 

The  program  can  carry  out  a history  analysis  for  solution  of 
Eqs . (15)  or  (16),  or  a response  spectrum  analysis  for  solution  of 

Eq , (16).  The  history  analysis  can  be  carried  out  using  mode  super- 

position or  direct  integration.  The  response  spectrum  analysis 
necessitates,  of  course,  first  the  solution  of  the  required  eigen- 
system  . 


7.1  Response  History  Analysis  by  Mode  Superposition 

In  the  mode  superposition  analysis,  it  is  assumed  that  the 
structural  response  can  be  described  adequately  by  the  p lowest 
vibration  modes,  where  p « n.  Using  the  transformation  u — $X , 
where  the  columns  in  $>  are  the  p M-orthonormalized  eigenvectors, 

Eq.  (15)  can  be  written  as 

X + + C?X  = *TR  (17) 
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where 


A = diag  (2cju^  ; Q2  = diag((L2)  (18) 

In  Eq.  (18)  it  is  assumed  that  the  damping  matrix  C satisfies  the 
modal  orthogonality  condition 

♦ *C».  =0  (i  / j)  (19) 

Equation  (17)  therefore  represents  p uncoupled  second  order  differen- 
tial equations.  These  are  solved  in  the  program  using  the  Wilson 
0-method,  which  is  an  unconditionally  stable  step-by-step  integration 
scheme  [6] . The  same  time  step  is  used  in  the  integration  of  all 
equations  to  simplify  the  calculation  of  stress  components  at  pre- 
selected times. 

In  the  case  of  prescribed  ground  motion  u = <|>X  and  in  Eq . (17) 

r 

T 

the  right  hand  side  is  given  by  -<|>  Mu^,  where  the  ground  acceleration 
is  considered  as  the  sum  of  the  components  in  the  x,  y and  z direc- 
tions as  described  in  Section  7.3. 

7.2  Response  History  Analysis  by  Direct  Integration 

The  solution  of  the  equations  of  motion,  Eqs.  (15)  and  (16),  can 
be  obtained  by  direct  integration  [6].  In  the  program  the  Wilson 
0-method  is  used,  which  is  unconditionally  stable.  The  algorithm 
employed  is  summarized  in  Table  4.  It  need  be  noted  that  Rayleigh 
damping  is  assumed,  i.e.  C = aU  + f?  K [ll].  This  form  of  damping  is 
easily  taken  account  of  in  the  analysis,  because  no  storage  and  no 
multiplications  for  a damping  matrix  are  required. 
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TABLE  4 : STEP-BY-STEP  DIRECT  INTEGRATION  ALGORITHM 

Initial  Calculations 

1.  Calculate  the  following  constants  (Assume  C = OfM+  pK)  . 


6 = 1.4,  t = 0At 


a = (6  + 3q"t)  / (t  +3(3t) 
o 

b = O'  - Ba 

0 o 

2 

a.  =•  6/t  + 3b  /t 

1 o 

a = 6/t  + 2b 

Ct  O 

a„  = 2 + Tb  /2 
o o 

a = 6/[  0(3  Pt  + -r2)] 


bl  " 8*4 


a&  = 3b^/T  - 6/(t  9) 


a = 2b.  - 6/ (t0) 

6 1 

a7  ■ b T/2  + 1 - 3/0 
a = At/2 

O 

ag  = At2/3 


310  2 a9 


2.  Form  effective  stiffness  matrix  K*  = K + a M . 

o 

* 

3.  Triangularize  K 
For  Each  Time  Increment 

★ 

1.  Form  effective  load  vector  . 

R*  = Rt  * e<lW  V * Mlai\  * Vt  + Vt1  • 

* 

2.  Solve  for  effective  displacement  vector  u^. 

* * * 

K ut  = Rt 

3.  Calculate  new  acceleration,  velocity  and  displacement  vectors, 
..  * ... 


t+£t 

= V 

t 

+ a 

5Ut  + a6Ut 

= u 

+ 

a ( 

u + u,  ) 

t + At 

t 

8 

t+At  t 

= U , 

+ 

At 

A + a^u*  + 

t+At 

t 

t 9 t 

4 .  Calculate  element  stresses  if  desired. 
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7,3  Response  Spectrum  Analysis 


In  this  analysis  the  ground  acceleration  vector  in  Eq . (16)  is 
written  as 


I * 

u 

g 


u -i-  u 
sx  gy 


+ u 

gz 


(20) 


where  u^,  and  u^  are  the  ground  accelerations  in  the  x,  y and 

z directions,  respectively.  The  equation  for  the  response  in  the 
r'th  mode  is  therefore 


xr  + 2?r  *_  + * = r + r + r 

r r r r r r rx  ry  rz 


(21) 


where  x^  is  the  r'th  element  in  X and 


rx 


- - $ Mu  ;r  = -♦T  Mu  • r 

r 6*  ry  r gy  ’ rrz 


-O  Mu 
r gZ 


(22) 


Using  the  definition  of  the  spectral  displacement  [10],  the  maximum 
absolute  modal  displacements  of  the  structure  subjected  to  an  accelera 
tion  into  the  x direction  are 


(max)  , T i 

\x  * *rl*r  *I,|Sx(»r) 

where  Sx  (a^)  is  the  spectral  displacement  into  the  x direction 
corresponding  to  the  frequency  w,  and  1^  is  a null  vector  except 
that  those  elements  are  equal  to  one  which  correspond  to  the  x- 
translat ional  degrees  of  freedom.  Similarly,  for  the  responses  due 
to  a ground  acceleration  into  the  y and  z-directions 


(23) 


(max) 

u 

ry 


(max) 

rz 


S (u?  ) (24) 

z r 
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and  the  total  maximum  response  in  the  r'th  mode  is  assumed  to  be 


(max)  (max)  (max)  (max) 

U — U + U + u 

r rx  ry  rz 


(25) 


Program  SAP  IV  calculates  the  maximum  responses  in  each  of  the  p 
lowest  modes,  where  the  spectra  (displacements  or  accelerations)  into 
the  x,  y and  z-directions  are  assumed  to  be  proportional  to  each  other. 
The  total  response  for  displacements  and  stress  resultants  is  calculated 
as  the  square  root  of  the  sum  of  the  squares  of  the  modal  maximum 
responses  [ 10 ] [36]. 


7.4  Restart  Capability  in  Mode  Superposition  Analysis 

The  most  expensive  phase  in  mode  superposition  analysis  is 
usually  the  calculation  of  frequencies  and  mode  shapes.  However,  once 
the  required  eigensystem  has  been  solved  for,  it  can  be  used  to  analyze 
the  structure  for  different  loading  conditions.  Also,  in  a design 
process  the  history  or  spectrum  analysis  for  the  same  loading  can  be 
carried  out  economically  a few  times,  for  example,  to  study  the  stress 
history  in  different  parts  of  the  structure. 

In  the  program,  at  completion  of  the  eigensystem  solution,  all 
variables  required  for  a response  history  or  response  spectrum  analysis 
together  with  the  frequencies  and  mode  shapes  are  written  on  low  speed 
storage.  The  program  execution  may  be  stopped  at  this  stage  and  the 
information  on  low  speed  storage  be  copied  to  a physical  tape.  Later, 
this  tape  would  be  copied  back  to  low  speed  storage  before  starting  a 
response  analysis.  If,  after  a number  of  response  analyses  using  the 
eigensystem  on  the  tape,  it  is  decided  that  more  frequencies  and  mode 
shapes  need  be  calculated,  the  information  on  the  tape  can  be  used  to 
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reduce  the  cost  of  the  new  eigensystem  solution  as  described  in 
Section  6.3. 

7,5  Mode  Superposition  Versus  Direct  Integration 

For  an  effective  response  history  analysis  the  user  must  decide 
appropriately  whether  to  use  mode  superposition  or  direct  integration. 
It  should  be  realized  that  the  direct  integration  is  equivalent  to  a 
mode  superposition  analysis  in  which  all  the  eigenvalues  and  vectors 
have  been  calculated  and  the  uncoupled  equations  in  Eq . (17)  with  p=n 

are  integrated  with  a common  time  step  At.  Naturally,  the  integration 
can  only  be  accurate  for  those  modes  for  which  At  is  smaller  than  a 
certain  fraction  of  the  period  T.  Using  the  Wilson  0-algorithm  the 
integration  errors  effectively  "filter"  the  high  mode  response,  for 
which  At/T  is  large,  out  of  the  solution.  This  filtering  is  due  to 
the  amplitude  decay  observed  in  the  numerical  solution  when  At/T  is 
large.  As  an  example,  Fig.  8 shows  the  amplitude  decay  for  the  initial 
value  problem  indicated  [6]. 

The  effective  filtering  of  the  high  frequency  response  from  the 
solution  may  be  beneficial.  Integration  accuracy  cannot  be  obtained 
in  the  response  of  the  modes  for  which  At/T  is  large  and  the  filtering 
process  allows  one  to  obtain  a total  system  solution  in  which  the 
low  mode  response  is  accurately  observed. 

It  is  therefore  noted  that  the  direct  integration  is  quite 
equivalent  to  a mode  superposition  analysis,  in  which  only  the  lowest 
modes  of  the  system,  but  a sufficient  number  to  take  proper  account  of 
the  applied  loading,  are  considered.  The  exact  number  of  modes  effec- 
tively included  in  the  analysis  depends  on  the  time  step  size  At  and 
the  distribution  of  the  periods. 
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The  advantages  of  mode  superposition  are  essentially  that 
frequencies  and  mode  shapes  are  obtained  and  that  a variety  of 
response  history  and  response  spectrum  analyses  can  be  carried  out  with 
relatively  small  additional  cost.  Also,  if  the  structure  is  slightly 
changed  or  more  eigenvalues  and  vectors  are  required,  i.e.,  the 
frequency  domain  to  be  considered  shall  be  extended,  the  eigensystem 
solved  for  already  can  be  used  to  reduce  the  cost  of  the  new  eigen- 
system solution  (see  Section  7,4). 

The  direct  step-by-step  integration,  however,  is  more  effective, 
when  many  modes  need  be  included  in  the  analysis  and  the  response  is 
required  over  relatively  few  time  steps,  such  as  in  shock  problems. 

It  should  be  noted  that  the  tape  reading  required  in  the  direct  inte- 
gration analysis  of  large  out-of-core  systems  can  be  costly  because 
in  the  solution  for  the  response  in  each  time  step  the  triangularized 
effective  stiffness  matrix  must  be  taken  into  high  speed  storage. 
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8.  DATA  CHECK  RUN 


In  the  analysis  of  large  structures  it  is  important  to  be  able  to 
check  the  data  read  and  generated  by  the  program.  For  this  purpose  an 
option  is  given  in  which  the  program  simply  reads  and  generates  all 
data,  prints  it  and  also  writes  the  full  data  on  low  speed  storage. 

At  completion  of  data  read  and  generation  the  information  on  low  speed 
storage  can  be  copied  to  a physical  tape.  This  tape  may  then  be  used 
to  plot  the  finite  element  mesh. 
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9. 


INSTALLATION  OF  SAP  IV  ON  A SYSTEM  OTHER  THAN  A CPC  COMPUTER 


SAP  IV  is  written  using  FORTRAN  IV  and  has  been  developed  on  a 
CDC  computer.  The  program  has  also  been  installed  with  relatively 
little  effort  on  IBM  and  UNIVAC  machines. 

The  program  or  parts  of  it  can  essentially  be  used  on  any  reasonably 
sized  computer.  SAP  IV  consists  of  about  14000  cards,  and  is  organized  in 
a standard  Fortran  overlay  structure  to  reduce  the  required  high  speed 
storage  for  program  execut ion .The  main  overlay  essentially  consists  of 
the  main  program.  The  secondary  overlays  are,  respectively,  the  element 
routines,  the  equation  solver,  the  eigenvalue  routines,  the  mode  super- 
position history  analysis  program,  the  spectrum  analysis  program  and  the 
direct  integration  routine.  Using  only  specific  overlays  efficient 
special  purpose  programs  are  obtained.  For  example,  using  the  main 
overlay  plus  the  secondary  overlays  of  the  pipe  element,  the  eigenvalue 
routines  and  the  response  history  analysis  a special  purpose  pipe 
response  history  analysis  program  by  mode  superposition  is  obtained.  On 
the  CDC  6400  of  the  University  of  California,  Berkeley,  the  complete 
program  with  12000^  high  speed  storage  locations  allocated  for 
solution  processing,  i.e.  the  blank  common  block  A has  a length  of  12000, 
requires  a field  length  of  about  1140008  for  execution. 

On  installation  of  SAP  IV  on  other  machines  than  the  CDC  series,  it 
must  be  observed  that  arithmetic  calculations  should  be  performed  using 
about  14  digit  words.  This  means  that,  for  example,  on  IBM  and  UNIVAC 
machines  double  precision  need  be  used.  The  calculations  to  be  performed 
in  double  precision  are  in  static  and  dynamic  analysis  the  formation  of 
element  stiffness  matrices,  the  formation  of  the  structure  stiffness 
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matrix  and  main  steps  in  the  solution  of  the  equations  of  motion,  namely, 

the  solution  of  Ku  = R,  the  solution  of  the  generalized  eigenvalue  problem 
2 

K(f > = uo  M(j)  and  in  the  direct  integration  the  solution  of  the  effective 

* 

displacements  u^  (see  Table  4).  These  calculations  need  primarily  be 
performed  in  double  precision  because  of  truncation  errors  occurring  when 
too  few  digits  are  used,  which  can  cause  large  errors  in  the  solution  and 
numerical  instabilities  [20]  [25]. 

With  regard  to  the  use  of  back-up  storage,  to  keep  the  program 
system  independent  sequential  accessing  is  used  throughout.  Therefore, 
since  no  advantage  is  taken  of  efficient  buffering  and  direct  access 
techniques,  it  need  be  noted  that  the  use  of  secondary  storage  can 
be  much  improved  when  tailored  to  a specific  system. 
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10.  CONCLUDING  REMARKS 


The  objective  in  this  part  of  the  report  was  to  present  a brief 
description  of  the  computer  program  SAP  IV.  The  program  is  a general 
analysis  tool  for  the  linear  static  and  dynamic  analysis  of  complex 
structures.  While  efficient  in  the  solution  process,  however,  it  should 
be  mentioned  that  pre-  and  post  processing  options  have  to  a large  extent 
not  been  developed;  mainly,  because  the  user  is  restricted  to  the 
particular  peripheral  equipment  available  to  him. 

With  regard  to  the  future  of  the  program,  various  important 
improvements  could  be  envisaged.  The  program  does  not  have  as  yet 
substructure  capabilities.  More  effective  use  of  back-up  storage  could 
be  achieved.  The  element  routines  could  be  further  improved.  A most 
important  aspect  are  general  error  control  procedures.  In  this  area  a 
significant  amount  of  research  is  still  required.  Considering  additional 
analysis  capabilities,  such  as  the  use  of  consistent  mass  matrices,  the 
possibility  of  including  geometric  and  material  nonlinearities,  etc.,  it 
may  be  mentioned  that  a nonlinear  static  and  dynamic  analysis  program 
is  presently  being  developed  [8], 
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SAMPLE  ANALYSES 


In  this  part  of  the  report  brief  problem  descriptions  for  a set  of 
standard  data  cases  available  with  program  SAP  IV  are  given.  Naturally, 
the  few  sample  analyses  can  only  demonstrate  to  a small  degree  the 
capabilities  of  the  program.  In  general,  detailed  problem  descriptions 
can  be  found  in  the  references  from  which  the  sample  analyses  have 
been  taken. 

1.  Static  Analysis  of  Pipe  Network 

The  pipe  network  shown  in  Fig.  9 corresponds  to  a sample  problem 
solution  presented  in  the  User's  Manual  for  the  mADLPIPEm  piping 
analysis  computer  code  [ 351  . The  purpose  of  this  analysis  is  to  pre- 
dict the  static  response  of  the  system  under  the  combined  effects  of: 

(1)  concentrated  loads 

(2)  vertical  (y-di rec t ion)  gravity  loads 

(3)  uniform  temperature  increase 

(4)  non-zero  displacements  imposed  at  one  support  point 

Table  5 compares  the  reactions  printed  in  the  SAP  and  ADLPIPE 
solutions.  The  two  solutions  are  in  fair  agreement;  the  SAP 
results  satisfy  equilibrium  to  all  six  digits,  appearing  in  the 
printed  output.  In  the  table  of  applied  loads,  a total  weight  of 
6284.03  lbs  results  from  950.686  inches  of  pipe  weighing  6.61  lbs 
per  inch. 

2.  Static  Shell  Analysis 

The  clamped  spherical  shell  shown  in  Fig.  10  is  analyzed  for 
stresses  produced  by  a uniform  pressure  applied  on  its  outside  surface. 
The  SAP  model  represents  a five  degree  wedge  of  the  shell  with  eighteen 
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TABLE  5 FORCE  EQUILIBRIUM  SUMMARY 

(SAP  ANALYSIS  OF  ADLPIPE  EXAMPLE  1 ) 


A.  REACTIONS 


NODE 

SAP 

ADLPIPE 

FX 

FY 

FZ 

FX 

FY 

FZ 

9 

5643.51 

. 

• 

5659. 

. 

11 

• 

-4044.59 

. 

• 

-4052. 

. 

12 

2350.08 

4023.01 

-4960.70 

2361. 

4026. 

-4  966. 

13 

-10993.59 

4505.61 

2960.70 

-11021. 

4509. 

2966. 

TOTAL 

-3000.00 

4484.03 

-2000.00 

-3001. 

4483. 

-2000. 

B.  APPLIED  LOADS 


LOADING  TYPE 

D I 

R E C T I 0 N 

X 

Y 

Z 

CONCENTRATED: 
at  node  3 

1000.00 

at  node  4 

. 

-200.00 

. 

at  node  8 

3000. 

1000.00 

2000. 

DISTRIBUTED 

WEIGHT: 

-6284.03 

TOTAL 

3000. 

-4484.03 

2000. 

SURFACE  STRESSES 


thin  shell  elements  along  the  thirty-nine  degree  meridian.  The  curves 
drawn  in  Fig.  10  are  plots  of  meridian  (d>)  and  circumferential  (0) 
direction  surface  stresses  predicted  by  the  SAP  program  at  the  element 
centroids. 

The  solution  of  this  problem  is  given  in  the  text  by  Timoshenko  l 27] , 
where  the  stress  distribution  of  Fig.  10  may  be  found  for  comparison. 

It  should  be  noted  that  program  SAP  calculates  membrane  stresses  (force 
per  unit  area)  and  bending  resultants  (moment  per  unit  length)  from 
which  the  surface  stresses  in  the  figure  have  been  evaluated. 

3.  Frequency  and  Mode  Shape  Analysis  of  Plane  Frame 

The  lowest  three  frequencies  and  corresponding  mode  shapes  of  the 
plane  frame  shown  in  Fig.  11  are  calculated.  The  results  can  be 
compared  with  the  solutions  published  in  references  [4]  [5]  . Note  that 
depending  on  the  high  speed  storage  available  either  a determinant 
search  or  a subspace  iteration  solution  may  be  performed.  The  three 
lowest  vibration  periods  of  the  frame  are  given  in  Table  6. 

4.  Response  Snectrum  Analysis  of  Pipe  Network 

A response  spectrum  analysis  of  the  pipe  assemblage  shown  in  Fig.  12 
is  carried  out.  This  is  example  1 in  the  User's  Manual  fpr  the  PIPDYN 
computer  program  [36].  Good  correspondence  between  the  SAP  and  PIPDYN 
solutions  is  obtained.  Table  7 compares  local  z-direction  member  end 
moments  calculated  by  the  two  programs.  In  the  analysis  the  lowest 
five  modes  are  considered.  Both,  horizontal  and  vertical  (proportional) 
spectra  are  simultaneously  specified. 


47 


10  AT  20 

200’ 

(a)  ELEVATION  OF  FRAME 

DATA  : YOUNG'S  MODULUS  = 432000 , MASS  DENSITY  = 1.0 

FOR  ALL  BEAMS  AND  COLUMNS  A,=3.0,  I,  = I2  = I3  = I.O 
UNITS:  FT,  KIPS 


!/ 


(b)  BEAM  ELEMENT  DEFINITION 
S,  ,S2  AND  S3  = BEAM  LOCAL  AXES 
I,  ,I2  AND  I3  = FLEXURAL  INERTIA  ABOUT  S,,S2,  AND  S3 
A,  = AREA  ASSOCIATED  WITH  S. 


FIGURE  II : SAP  MODEL  OF  PLANE  FRAME 
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TABLE  6 PERIODS  OF  PLANE  FRAME 


MODE 

PERIOD 

NUMBER 

(SEC) 

1 

8.183 

2 

2.673 

3 

1.543 

TABLE  7 COMPARISON  OF  MDMENT  PREDICTIONS 

(SAP  ANALYSIS  OF  PIPDYN  EXAMPLE  1) 


MOMENT  MZ  (Kip  in)  IN  ELEMENT  LOCAL 
COORDINATES  (at  element  ends  1*  see 


ELEMENT 

NUMBER 


Ref.  29  pp.  54) 


SAP 


PIPDYN 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 


376.9 
30.67 

152.9 

100.6 

83. 27 
46.17 
1.081 
21.59 
7.052 
7.537 
160.3 

78.07 

26.08 


377.0 

30.68 

152.9 

100.6 

83.27 

46.19 

1.082 

21.81 

7.038 

7.571 

160.4 

78.09 

25.80 
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— MOde  S^SSIHISIL  Urn,  History  Response  Analysis  of  Cantilever 
The  cantilever  bean,  shown  in  Fig.  13  u analyzed  for 

acceleration  shown  in  the  same  figure.  The  solution  t 

6 Bl  ine  solution  to  this  problem 

15  °btalned  ‘-dependently  using  the  "DRA2"  computer  code  [211.  This 

program  calculates  the  dynamic  response  by  direct  integration  of  the 

(coupled)  equations  of  motion  using  the  Wilson  6-algorithm  (61. 

The  response  history  of  the  beam  model  is  evaluated  in  SAP  using 

-Ode  superposition  including  all  eight  flexural  modes  developed  in  the 

cantilever;  Table  8 lists  the  periods  of  these  eight  modes  computed 

by  SAP.  Figure  14  shows  the  variation  or  tho  + 

ne  variation  of  the  transverse  displacements 

and  of  the  fixed-end  moment  calculated  by  SAP.  The  DM2  predictions 

agree  with  the  SAP  results  to  5 or  more  digits  and.  consequently,  are 
not  shown  for  comparison. 

— ”°de  SuperP°sl“°"  Time  History  Response  Analysis  of  Cylindrical  Tube 
The  response  of  the  simply  supported  cylindrical  tube  shown  in  Fig.  15 

for  applied  load  is  calculated  by  mode  superposition . Using  sym- 

metry one  half  the  tube  is  idealized  as  an  assemblage  of  axisymmetric 
elements  with  a total  of  61  degrees  of  freedom.  In  the  mode  superposi- 
tion analysis  only  the  lowest  twenty  modes  are  considered;  some  of  the 
vibration  periods  are  listed  in  Table  9.  Figure  15  shows  a comparison 

of  the  radial  displacements  calculated  by  the  program  with  a Timoshenko- 
U>ve  solution  [24]. 
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I = 1.0  in4;  A = 100.0 in2 
E = 30  x I06 1 bs  / In2 
p =1.0  lb- sec2/ In4 


(a)  NODE  AND  BEAM  NUMBER  ASSIGNMENTS  FOR  THE 
CANTILEVER  MODEL 


(b)  GROUND  ACCELERATION  APPLIED  AT  NODE  1 


FIGURE  13:  RESPONSE  HISTORY  ANALYSIS  OF 
CANTILEVER  BEAM 
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TABLE  8 CANTILEVER  BEAM  ANALYSIS  - 

NATURAL  PERIODS  FOR  THE  EIGHT  (LCWEST) 
FLEXURAL  MODES 


MODE 

NUMBER 

PERIOD 

(SEC) 

1 

525.79 

2 

85.368 

3 

30.965 

4 

16.059 

5 

9.9006 

6 

6.8276 

7 

5.1865 

8 

4.3777 

TABLE  9 CYLINDRICAL  TUBE  ANALYSIS  “ 
SOME  NATURAL  PERIODS 


MODE 

NUMBER 

PERIOD 
(SEC  X 10-3) 

1 

1.2788 

5 

0.62140 

10 

0.32983 

15 

0.17463 

20 

0,11497 
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u-Do-iiN./  TRANSVERSE 


g 80,000 


0 2 4 6 8 10  12  14  16 

TIME  (SEC) 

(a)  TRANSVERSE  DEFLECTIONS 


2 4 6 8 10  12 

TIME  (SEC) 

(b)  MOMENT  AT  NODE  1 

(FIXED  END  OF  CANTILEVER) 


14  16 


FIGURE  14:  CANTILEVER  RESPONSE 


RADIAL  DISPLACEMENT  ( INCHES  x 10' 


P=  1000  Ibs/in 


W t -w 


h = 0.3 


I 


\ f p ^ )///)// 


18 


E=30xl06  Ibs/in2 


I/=0.3 


«2, 


p= 3.663  10  lbs 
sec2/ In4 


a)CYLINDRICAL  TUBE 


P Ibs/ln 


1000 


TIME 


b)  TIME  VARIATION 
OF  LOAD 


c)  RADIAL  DISPLACEMENT  VERSUS  TIME 


FIGURE  15 : RESPONSE  HISTORY  ANALYSIS  OF 
CYLINDRICAL  TUBE 
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7 . Direct  Integration  Time  History  Response  Analysis  of  Cylindrical 
Tube 

The  response  of  the  simply  supported  tube  shown  in  Fig.  15  for  the 
applied  load  is  calculated  by  direct  integration.  The  same  finite 
element  idealization  and  time  step  At  as  in  the  mode  superposition  is 
used.  Figure  15  shows  the  radial  displacements  as  calculated  by  the 
program. 
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APPENDIX  - DATA  INPUT  TO  SAP  IV 


I.  HEADING  CARD  (12A6) 

notes 

columns 

variable 

entry 

(1) 

1-72 

HED (12) 

Enter  the  heading  information  to  be 
printed  with  the  output 

NOTES/ 

(1)  Begin  each  new  data  case  with  a new  heading  card. 


1.1 


II . 

MASTER  CONTROL  CARD 

(815) 

not  es 

columns 

variable 

en  t ry 

(i) 

1-5 

NUMNP 

Total  number  of  nodal  points  (joints) 
in  the  model 

(2) 

6-10 

NELTYP 

Number  of  element  groups 

(3) 

11  - 15 

LL 

Number  of  structure  load  cases; 

GE.l;  static  analysis 

EQ.O  ; dynamic  analysis 


(4)  16  - 20  NF 


(5)  21  - 25  NDYN 


(6)  26  - 30  MODEX 


Number  of  frequencies  to  be  found 
in  the  eigenvalue  solution; 

EQ.O;  static  analy  sis  , Mo 

GE.l;  dynamic  analysis  f or  / •'  -or 

1 '<< 

Analysis  type  code:  ;Vy» 

EQ.O;  static  analysis  r> 

EQ.l;  eigenvalue/vector  solution 

EQ.2 ; forced  dynamic  response  by 

mode  superposition 

EQ.3;  response  spectrum  analysis 

EQ.4;  direct  step-by-step  integration 

• - * . 5 • * ' C ‘ *-  -r  , i 1 t>  ' ; y . • ^ 

Program  execution  mode: 

EQ.O;  problem  solution 

EQ.l;  data  check  only 


EQ.3; 

EQ.4; 


(7)  31  - 35  NAD 


(8) 

36  - 40 

KEQB 

It 

^ ' -i? 

M 10  s V 

, i 0 / 

-r  j ..  ■'> 

4 ' * 

NOTES/ 

Total  number  of  vectors  to  be  used 
in  a SUBSPACE  I NTE RATION  solution  for 
eigenvalues/vectors : 

EQ.O;  default  set  to: 

MIN  {2*NF, NF+8  } 

Number  of  degrees  of  freedom 
(equations)  per  block  of  storage: 
EQ.O;  calculated  automatically 

**  by  the  program 

•"* . v'y?  w- • 


(1)  Nodes  are  labeled  with  integers  ranging  from  ' 1 to 
the  total  number  of  nodes  in  the  system,  mNUMNPm . 
The  program  exits  with  no  diagnostic  message  if 
NUMNP  is  zero  (0).  Thus,  two  blank  cards  are  used 
to  end  the  last  data  case  in  a run;  i.e.,  one  blank 
heading  card  (Section  I)  and  one  blank  card  for 
this  section. 

(2)  For  each  different  element  type(TRUSS,  BEAM,  etc.)  a 
new  element  group  need  be  defined.  Elements  within 
groups  are  assigned  integer  labels  ranging  from  *1 
to  the  total  number  of  elements  in  the  group. 
Element  groups  are  input  in  Section  IV,  below. 


II. 1 


II. 


MASTER  CONTROL  CARD  (continued) 


Element  numbering  must  begin  with  one  (1)  in  each  different 
group.  It  is  possible  to  use  more  than  one  group  for  an 
element  type.  For  example,  all  columns  (vertical  beams)  of 
a building  may  be  considered  one  group  and  the  girders 
(horizontal  beams)  may  be  considered  another  group. 

(3)  At  least  one  (1)  load  condition  must  be  specified  for  a 
static  (NDYN.EQ.O)  analysis.  If  the  data  case  calls  for  one  of 
the  dynamic  analysis  options  (NDYN.EQ.l,  2,  3,  or  4)^»  no 

load  cases  can  be  requested  (i.e.,  LL  is  input  as  0 ). 

The  program  always  processes  Sections  V (Concentrated 
Load/Mass  Data)  and  VI  (Element  Load  Multipliers)  and 
expects  to  read  some  data.  For  the  case  of  a dynamic 
analysis  (NDYN.GE.l)  only  mass  coefficients  can  be  input 
in  Section  V,  and  one  (1)  blank  element  load  multiplier 
card  is  expected  in  Section  VI. 

(4)  For  a static  analysis,  NF.EQ.O.  If  NDYN.EQ.l,  2 or  3,  the 
lowest  NF  eigenvalues  are  determined  by  the  program.  Note 
that  a dynamic  solution  may  be  re-started  after  eigenvalue 
extraction  (providing  a previous  eigenvalue  solution  for 
the  model  was  saved  on  tape  as  described  in  Appendix  A) . 

NF  for  the  original  and  re-start  runs  must  be  the  same. 

(5)  If  NDYN.EQ.2  or  NDYN.EQ.3  the  program  first  solves  for  NF 
eigenvalues/vectors  and  then  performs  the  forced  response 
solution  (or  the  response  spectrum  analysis).  Thus,  the 
program  expects  to  read  the  control  card  governing  the 
eigensolution  (Section  VII. A)  before  reading  data  in 
either  Sections  VII. B or  VII. C.  For  the  case  NDYN.EQ.l, 
the  program  solves  for  NF  eigenvalues/vectors,  prints  the 
results  and  proceeds  to  the  next  data  case.  The  results 
for  the  eigenvalue  solution  phase  (NDYN.EQ.l)  may  be 
saved  for  later  use  in  automatic  re-start  (Appendix  A 
lists  the  control  cards  that  are  required  to  affect  this 
save  operation),  i.e.  a dynamic  solution  may  be  restarted 
without  repeating  the  solution  for  modes  and  frequencies* 

If  this  data  case  is  a re-start  job,  set  NDYN.EQ.-2  for  a 
forced  response  solution,  or  set  NDYN.EQ.-3  for  a response 
spectrum  analysis.  Note  that  the  solution  may  be  re-started 
a multiple  of  times  (to  run  different  ground  spectra  or 
different  time-dependent  forcing  functions)  because  the 
program  does  not  destroy  the  contents  of  the  re-start  tape. 

If  NDYN.EQ.4  the  program  performs  the  response  solution  by 
direct  step-by-step  integration  and  no  eigenvalue  solution 
control  card  should  be  provided. 


II.  MASTER  CONTROL  CARD  (continued) 

(6)  In  the  dat a-check-only  mode  (MODEX.EQ. 1) , the  program 
writes  only  one  file,  "TAPES",  and  this  file  may  be 
saved  for  use  as  input  to  special  purpose  programs  such 
as  mesh  plotters,  etc.  TAPE8  contains  all  data  input 
in  its  completely  generated  form.  If  MODEX.EQ. 1,  most 
of  the  expensive  calculations  required  during  normal 
(MODEX.EQ. 0)  execution  are  passed.  TAPE8,  however,  is 
not  written  during  normal  problem  solution. 

Note  that  a negative  value  for  NDYN  ("-2  or  -3  ) , 
when  executing  in  the  dat a-check-only  mode,  does  not 
cause  the  program  to  read  the  re-start  tape  which 
contains  the  eigensolution  information;  instead,  the 
program  jumps  directly  from  this  card  to  Section  VII. B 
(or  Section  VII. C)  and  continues  reading  and  checking 
data  cards  without  performing  the  solution. 

(7)  If  the  program  is  to  solve  for  eigenvalues  using  the 
SUBSPACE  ITERATION  algorithm,  the  entry  in  cc  31-35 
can  be  used  to  change  the  total  number  of  iteration 
vectors  to  be  used  from  the  default  minimum  of  2*NF 
or  NF+8  (whichever  is  smaller)  to  the  value  'NAD  . 

The  effect  of  increasing  NAD  over  the  default  value 
is  to  accelerate  convergence  in  the  calculations  for 
the  lowest  NF  eigenvalues.  NAD  is  principally  a pro- 
gram testing  parameter  and  should  normally  be  left  blank. 

(8)  KEQB  is  a program  testing  parameter  which  allows  the 
user  to  test  multiple  equation  block  solutions  using 
small  data  cases  which  would  otherwise  be  one  block 
problems.  KEQB  is  normally  left  blank. 


II. 3 


III.  NODAL  POINT  DATA  (A1 , 14 , 61 5 , 3F10 . 0 , 15 , FlO .0) 


notes  columns 


variable  entry 


(1)  1 CT 


(2)  2-5  N 


Symbol  describing  coordinate  system 
for  this  node; 

EQ.  ; (blank)  cartesian  (X,Y,Z) 
EQ.C;  cylindrical  (R,Y,  0) 

Node  number 


(3) 

6 - 

10 

IX(N,1) 

11  - 

15 

IX (N, 2) 

16  - 

20 

IX (N, 3) 

21  - 

25 

IX (N  ,4 ) 

26  - 

30 

IX  (N,  5) 

31  - 

35 

IX  (N, 6) 

(4) 

36  - 

45 

X (N) 

46  - 

55 

Y(N) 

56  - 

65 

Z(N) 

(5) 

66  - 

70 

KN 

(6) 

71  - 

80 

T (N) 

NOTES / 


X- translation  boundary  condition  code 
Y-translation  boundary  condition  code 
Z-translat ion  boundary  condition  code 
X-rotation  boundary  condition  code 
Y-rotation  boundary  condition  code 
Z-rotation  boundary  condition  code 
EQ.O;  free  (loads  allowed) 

EQ.l;  fixed  (no  load  allowed) 

GT.l;  master  node  number  (beam  nodes 

only) 


X (or  R)  -ordinate 
Y -ordinate 

Z (or  8)  -ordinate  (degrees) 


Node  number  increment 


Nodal  temperature 


(1)  A special  cylindrical  coordinate  system  is  allowed 

for  the  global  description  of  nodal  point  locations.  If 
a "c"  is  entered  in  card  column  one  (1) , then  the  entries 
given  in  cc  36-65  are  taken  to  be  references  to  a 
global  (R,Y,  0)  system  rather  than  to  the  standard 
(X,Y,Z)  system.  The  program  converts  cylindrical 
coordinate  references  to  cartesian  coordinates  using 
the  formulae : 


X = R sin  0 
Y = Y 
Z = R cos0 

Cylindrical  coordinate  input  is  merely  a user  conveni- 
ence for  locating  nodes  in  the  standard  (X,Y,Z)  system, 
and  no  other  references  to  the  cylindrical  system  are 
implied;  i.e.,  boundary  condition  specifications,  out- 
put displacement  components,  etc.  are  referenced  to 
the  (X,Y,Z)  system. 

(2)  Nodal  point  data  must  be  defined  for  all  (NUMNP)  nodes. 
Node  data  may  be  input  directly  (i.e.,  each  node  on 
its  own  individual  card)  or  the  generation  option 

may  be  used  if  applicable  (see  note  5,  below). 


III.l 


III.  NODAL  POINT  DATA  (continued) 


Admissible  nodal  point  numbers  range  from  Ml<f  to  the  total 
number  of  nodes  NUMNP  . Illegal  references  are: 

N.LE.O  or  N. GT. NUMNP. 


(3)  Boundary  condition  codes  can  only  be  assigned  the 
following  values  (M  = 1,2,... ,6): 


IX(N,M)  = 0;  unspecified  (free)  displacement 
(or  rotation)  component 
IX  (N , M)  = 1;  deleted  (fixed)  displacement 
(or  rotation)  component 
IX  (N , M)  = K;  node  number  "k"  (1  < K ^ NUMNP 
and  K £ N)  is  the  "master"  node 
to  which  the  Mth  degree  of  free- 
dom at  node  "n"  is  a "slave" 


An  unspecified  (IX(N,M)  = 0)  degree  of  freedom  is  free 
to  translate  or  rotate  as  the  solution  dictates. 
Concentrated  forces  (or  moments)  may  be  applied  (Section 
V,  below)  in  this  degree  of  freedom.  One  (1)  system 
equilibrium  equation  is  required  for  each  unspecified 
degree  of  freedom  in  the  model.  The  maximum  number 
of  equilibrium  equations  is  always  less  than  six  (6) 
times  the  total  number  of  nodes  in  the  model. 

Deleted  (IX(N,M)  = 1)  degrees  of  freedom  are  removed 
from  the  final  set  of  equilibrium  equations.  Deleted 
degrees  of  freedom  are  fixed  (points  of  reaction),  and 
any  loads  applied  in  these  degrees  of  freedom  are 
ignored  by  the  program.  Nodes  that  are  used  for 
geometric  reference  only  (i.e.,  nodes  not  assigned 
to  any  element)  must  have  all  six  (6)  degrees  of  free- 
dom deleted.  Nodal  degrees  of  freedom  having  undefined 
stiffness  (such  as  rotations  in  an  all  TRUSS  model, 
out-of-plane  components  in  a two-dimensional  planar 
model,  etc.)  should  be  deleted.  Deletions  have  the 
beneficial  effect  of  reducing  the  size  of  the  set  of 
equations  that  must  be  solved.  The  table  below  lists 
the  types  of  degrees  of  freedom  that  are  defined  by 
each  different  element  type.  The  table  was  prepared 
assuming  that  the  element  has  general  orientation  in 
(X,Y,Z)  space. 


DEGREES 


ELEMENT  TYPE  6X 

1.  TRUSS  x 

2 . BEAM  x 

3.  MEMBRANE  x 

1 2D  QUADRILATERAL 

5.  3D  BRICK  x 

G.  PLATE.  SHELL  x 

7.  BOUNDARY  x 


FREEDOM  WITH 

DEFINED 

STIFFNESS 

iY 

oZ 

6ex 

6ev 

6ez 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

X 

III. 2 


Ill,  NODAL  POINT  DATA  (continued) 


DEGREES 

OF  FREEDOM  WITH 

DEFINED 

STIFFNESS 

ELEMENT  TYPE 

6X 

6Y 

6Z 

6«x 

66y  60z 

8.  THICK  SHELL 

X 

X 

X 

9.  3 D/PI PE 

X 

X 

X 

X 

X X 

Hence,  for  an  all  3D/BRICK  model,  only  the  X,Y,Z 
translations  are  defined  at  the  node,  and  the  number 
of  equations  can  be  cut  in  half  by  deleting  the  three 
(3)  rotational  components  at  every  node.  If  a node 
is  common  to  two  or  more  different  element  types,  then 
the  non-trivial  degrees  of  freedom  are  found  by  combi- 
nation. For  example,  all  six  (6)  components  are  possible 
at  a node  common  to  both  BEAM  and  TRUSS  elements;  i.e., 
the  BEAM  governs. 

A master/slave  option  is  allowed  to  model  rigid 

links  in  the  system.  For  this  case,  IX(N,M)  = K means 

that  the  Mth  degree  of  freedom  at  node  "n"  is  "slave" 

to  (dependent  on)  the  same  (Mth)  degree  of  freedom  at 

node  K ; node  "k"  is  said  to  be  the  master  node  to 

which  node  N is  slave.  Note  that  no  actual  beam  need  to  run 

from  node  K to  node  N,  however  the  following  restrictions  hold: 

(a)  Node  one  (1)  cannot  be  a master  node;  i.e., 

K / 1. 

(b)  Nodes  "n"  and  "k"  must  be  beam-only  nodes  ; 
i.e.,  no  other  element  type  may  be  connected 
to  either  node  N or  K. 

(c)  A node  "n"  can  be  slave  to  only  one  master  node,"K"; 
multiple  nodes,  however  , can  be  slave  to  the  same  master. 

(d)  If  the  beam  from  "n"  to  "k"  is  to  be  a 
rigid  link  arbitrarily  oriented  in  the 

X,Y,Z  space,  then  all  six  (6)  degrees  of  free- 
dom at  node  N must  be  made  slaves  to  node  "k" 

Displacement/rotation  components  for  slave  degrees  of 
freedom  at  node  "n"  are  not  recovered  for  printing; 
i.e.,  zeroes  appear  as  output  for  slave  degrees  of 
f reedom . 

(4)  When  CT  (Col.  1)  is  equal  to  the  character  "c",  the  values 
input  in  CC  36-65  are  interpreted  as  the  cylindrical  (R, Y, 6) 
coordinates  of  node  "n".  Y is  the  axis  of  symmetry.  R is 
the  distance  of  a point  from  the  Y-axis.  The  angle  0 is 
measured  clockwise  from  the  positive  Z-axis  when  looking  in  the 
positive  Y direction.  The  cylindrical  coordinate  values  are 
printed  as  entered  on  the  card  , but  immed  lately  after  print ing  the 


III.  NODAL  POINT  DATA  (continued) 


(5) 


«th  cylLdrlca  ^coordinates""  "°de  haPPC"S  b° 

“:X"!  r ^rii^r  r r r r— : 

~st  be  defined . doint  da^forY^eToTno^  ‘ U ‘ 


fNl-  N!+1  X KN2,  N1+2  x 


KN 


-2>...,n2] 


inysiquence:ated  fr°m  inf°rmation  Siven  on  two  (2)  cards 


CARD  1 / N1.IX(N1,l),...,IX(Nlf6)fX(Nl),...,KNllT(Nl)/ 

CARD  2 / N2,IX(N2,l)f...,IX(N2f6)fX(N2)f  ...|KN2jT(n2)/ 

given  on  the  ^ 

Ni  +1  x kn  . ?u  The  flrst  generated  node  is 

1 KN2 , the  second  generated  node  is  N +2  y vm  + 
Generation  continues  until  node  „ J , -Lu  ■ s2 ' 
established.  Note  that  the  nod.  difference™2  -N  „ust 

N and")/  d‘Vl*lble  by  KN2-  Intermediate  nodes  between 

lt2ll„  **  eq“al  intervals  along  the 

btraignt  line  between  the  two  nnin  + o r>  ~ 

codes  for  the  generated  data  are  set  eq^^Le^T'0" 

given  on  the  first  card.  Node  temperatures  are  found 

mear  interpolation  between  T(N,)  and  T(N  ) r ^ 

generation  is  always  performed  ii  the  (X  s T ! 

no  generation  is  performed  if  KNg  is  zeri  '(bL« 

(6)  Nodal  temperatures  describe  the  actual  (physical) 
temperature  distribution  in  the  structure  Ave” 

a«musedtt"Perit''reS  eSt“bllS"ed  f™  «he  nodal  values 


III. 4 


IV. 


ELEMENT  DATA 


TYPE  1 - THREE-DIMENSIONAL  TRUSS  ELEMENTS  ~ " 

Truss  element s are  identified  by  the  number  1.  Axial  forces  and 
stresses  are  calculated  for  each  member.  A uniform  temperature 
change  and  inertia  loads  in  three  directions  can  be  considered 
as  the  basic  element  load  conditions.  The  truss  elements  are 
described  by  the  following  sequence  of  cards: 


A.  Control  Card  (315) 

Columns  1 - 5 The  number  1 

6-10  Total  number  of  truss  elements 
11  - 15  Number  of  material  property  cards 

\£>  - 20  TVpr  Apr  rflir*; 

- f - ■ ■'  • ; ^ ■ i r 

B.  Material  Property  Cards  (I5,5Fl0.0) 

There  need  be  as  many  of  the  following  cards  as  are 
necessary  to  define  the  properties  listed  below  for  each 
element  in  the  structure. 


C. 


Columns 


1-5 
6-15 
16  - 25 
26  - 35 
36-45 
46  - 55 


Material  identification  number 

Modulus  of  elasticity 

Coefficient  of  thermal  expansion 

Mass  density  (used  to  calculate  mass  matrix) 

Cross'- sect  ional  area*  or  *vV:  ^r*  ''  : ■ 

Weight  density  (used  to  calculate  gravity 

loads) 

_r  t 


Element  Load  Factors  (4F10.0)  Four  cards 


Three  cards  specifying  the  fraction  of  gravity  (in  each 
of  the  three  global  coordinate  directions)  to  be  added 
to  each  element  load  case. 


D. 


Card  1: 
Columns 

Card  2 : 
Card  3: 
Card  4 : 

Element 


Multiplier  of  gravity  load  in  the  +X  direction 

1-10  Element  load  case  A 

11  - 20  Element  load  case  B 

21  - 30  Element  load  case  C 

31  - 40  Element  load  case  D 

As  above  for  gravity  in  the  +Y  direction 

As  above  for  gravity  in  the  +Z  direction 

This  indicates  the  fraction  of  the  thermal  load 
to  be  added  to  each  of  the  element  load  cases. 

Data  Cards  (4 15 , F10 . 0 , 15) 


One  card  per  element  in  increasing  numerical  order  starting 
with  one. 


Columns  1 - 5 Element  number 


IV. 1.1 


IV.  ELEMENT  DATA  (continued) 


NOTES/ 


(1) 


Columns 


6-10 

Node  number  I 

11  - 15 

Node  number  J 

16  - 20 

Material  property  number 

21  - 30 

Reference  temperature 

for  zero  stress 

31  - 35 

Optional  parameter  k used  for  automatic 

“2  r a 

generation  of  element 

data. 

If 

N. 


a series  of  element s 'exist  such  that  the  element  number, 
is  one  greater  than  the  previous  element  number  (i.e. 

ven  by 


- N^_i  + 1)  and  the  nodal  point  number  can  be  gi 


J.  = J.  . + k 

1 l-l 

then  only  the  first  element  in  the  series  need  be  provided. 
The  element  identification  number  and  the  temperature  for 
the  generated  elements  are  set  equal  to  the  values  on  the 
first  card.  If  k (given  on  the  first  card)  is  input  as 
zero  it  is  set  to  1 by  the  program. 

(2)  The  element  temperature  increase  AT  used  to  calculate 
thermal  loads  is  given  by 


AT  = (T . + T . ) /2 . 0 - T 
1 J r 

where  (T  + T )/2.0  is  the  average  of  the  nodal  temperatures 
specified  on  the  nodal  point  data  cards  for  nodes  i and  j; 
and  Tr  is  the  zero  stress  reference  temperature  specified 
on  the  element  card.  For  truss  elements  it  is  generally 
more  convenient  to  set  T±  = Tj  = 0.0  such  that  AT  = -Tr 
(note  the  minus  sign) . Other  types  of  member  loadings 
can  be  specified  using  an  equivalent  AT.  If  a truss 
member  has  an  initial  lack  of  fit  by  an  amount  d (positive 
if  too  long)  then  AT  =d/(cvL)  . If  an  initial  prestress 
force  P (positive  if  tensile)  is  applied  to  the  member 
ends  that  is  released  after  the  member  is  connected  to 
the  rest  of  the  structure  then  AT  = - P/(aAE).  In  the 
above  formulas  A = cross  section  area,  L = member  length 
and  a = coefficient  of  thermal  expansion. 


IV. 1.2 


IV. 


ELEMENT  DATA  (continued) 


TYPE  2 - THREE-DIMENSIONAL  BEAM  ELEMENTS 

Beam  elements  are  identified  by  the  number  2.  Forces  (axial  and 
shear)  and  moments  (bending  and  torsion)  are  calculated  (in  the 
beam  local  coordinate  system)  for  each  beam.  Gravity  loadings 
in  each  coordinate  direction  and  specified  fixed  end  forces  form 
the  basic  element  load  conditions. 

The  beam  elements  are  described  by  the  following  sequence  of 
cards: 


Control  Card  (515) 

Columns  1 - 5 The  number  2 

6-10  Total  number  of  beam  elements 
11  - 15  Number  of  element  property  cards 
16  - 20  Number  of  fixed  end  force  sets 
21  — 25  Number  of  material  property  cards 

Material  Property  Cards  (I5,3Fl0.0) 

Columns  1 - 5 Material  identification  number 

6-15  Young's  modulus 
16  - 25  Poisson's  ratio 

26  - 35  Mass  density  (used  to  calculate  mass  matrix) 
36  - 45  Weight  density  (used  to  calculate  aravitv 
loads) 

Element  Property  Cards  (I5,6Fl0.0) 


Columns  1 - 5 Geometric  property  number 

6-15  Axial  area 

16  - 25  Shear  area  associated  with  shear  forces  in 
local  2-direction 

26  - 35  Shear  area  associated  with  shear  forces  in 
local  3-direction 
36  - 45  Torsional  inertia 

46  - 55  Flexural  inertia  about  local  2-axis  ] 

56  - 65  Flexural  inertia  about  local  3-axis  \ °r 

J >/;  - 

One  card  is  required  for  each  unique  set  of  properties. 

Shear  areas  need  be  specified  only  if  shear  deformations 
are  to  be  included  in  the  analysis. 


IV. 2. 1 


IV. 


ELEMENT  DATA  (continued) 


NOTE* 

K IS  ANY  NOOAL  POINT 
WHICH  LIES  IN  THE  LOCAL 
1-2  PLANE  (NOT  ON  THE  1-AXIS) 


LOCAL  COORDINATE  SYSTEM  FOR  BEAM  ELEMENT 

D.  Element  Load  Factors  (4F10.0) 

Nodal  point  loads  (no  moments)  due  to  gravity  are  computed. 

Three  cards  need  be  supplied  which  specify  the  fraction  of  these 
loads  (in  each  of  the  three  global  coordinate  directions)  to  be 
added  to  each  element  load  case. 


Card  1 : 
Columns 

Card  2: 
Card  3: 


Multiplier  of  gravity  load  in  the  +X  direction 


1 

11 

21 

31 


10  Element  load  case  A 
20  Element  load  case  B 
30  Element  load  case  C 
40  Element  load  case  D 


As  above  for  gravity  in  the  +Y  direction 


As  above  for  gravity  in  the  +Z  direction 


\ 


E. 


Fixed-End  Forces  (15 , 6F10 . 0/15 , 6F10 .0) 

Two  cards  are  required  for  each  unique  set  of  fixed-end  forces 
occurring  in  the  analysis.  Distributed  loads  and  thermal  loads 
can  be  specified  using  the  fixed-end  forces. 


Ca  rd  1 : 


Columns 


1 - 

5 

6 - 

15 

16  - 

25 

26  - 

35 

36  - 

45 

46  - 

55 

56  - 

65 

Fixed-end 

Fixed-end 

Fixed-end 

Fixed-end 

Fixed-end 

Fixed-end 

Fixed-end 


force  number 

force  in  local  1-direction  at  Node  I 

force  in  local  2-direction  at  Node  I 

force  in  local  3-direction  at  Node  I 

moment  about  local  1-direction  at  Node  I 

moment  about  local  2-direction  at  Node  I 

moment  about  local  3-direction  at  Node  I 


IV. 2. 2 


IV.  ELEMENT  DATA  (continued) 


Card  2 : 
Columns 


1 - 

5 

Blank 

6 - 

15 

Fixed-end 

16  - 

25 

Fixed-end 

26  - 

35 

Fixed-end 

36  - 

45 

Fixed-end 

46  - 

55 

Fixed-end 

56  - 

65 

Fixed-end 

s J 
; J 
? J 
Node 


Note  that  values  input  are  literally  fixed-end  values. 
Corrections  due  to  hinges  and  rollers  are  performed  within  the 
program.  Directions  1,  2 and  3 indicate  principal  directions  in 
the  local  beam  coordinates 

F.  Beam  Data  Cards  (1015,216,18) 


Columns 


1 

5 

6 

- 

10 

11 

- 

15 

16 

- 

20 

21 

- 

25 

26 

- 

30 

31 

- 

35 

36 

- 

40 

41 

- 

45 

46 

- 

50 

51 

- 

56 

57 

- 

62 

63 

- 

70 

Element  number 
Node  number  I 
Node  number  J 

Node  number  K - see  accompanying  figure 
Material  property  number 
Element  property  number 
A 


B 

C 

D 

End 

End 


Fixed-end  force  identification  for 
element  load  cases  A,  B,  Ct  and  D 
respec  t ive ly 

release  code  at  node  I 

release  code  at  node  J 

Optional  parameter  k used  for  automatic 
generation  of  element  data.  This  option  is 
described  below  under  a separate  heading.  If 
the  option  is  not  used,  the  field  is  left  blank. 

The  end  release  code  at  each  node  is  a six  digit  number  of  ones 

and/or  zeros.  The  1st . 2nd . ...  . 6th0di*“S  "“E ^ 
correspond  to  the  force  components  Rl , R2 , R3 , Ml,  M2, 

each  node. 

If  any  one  of  the  above  element  end  forces  is  known  to  be  zero 
(hinge  or  roller),  the  digit  corresponding  to  that  component 

a one . 


NOTES/ 

(!)  n „ series  of  elements  occurs  In  .hich  each  element  number  Is  one 

greater  than  the  previous  number  NEi_1 


i . e.  , 


NE.  = NE.  + 1 
1 1-i 


only  the  element  data  card  for  the  firs,  element  In  the  series  need  be  given 
as  input,  provided 


IV. 2. 3 


IV.  ELEMENT  DATA  (continued) 


(1)  The  end  nodal  point  numbers  are  - NIi k 

NJ.  = NJ.  . + k 
l l-l 

and  the 

(2)  material  property  number 

(3)  element  property  number 

(4)  fixed-end  force  identification  numbers  for  each  element  load  case 

(5)  element  release  code 

(6)  orientation  of  local  2-axis 

are  the  same  for  each  element  in  the  series. 

The  value  of  k,  if  left  blank,  is  taken  to  be  one.  The  element  data  card 
for  the  last  beam  element  must  always  be  given. 

(2)  When  successive  beam  elements  have  the  same  stiffness,  orientation 

and  element  loading,  the  program  automatically  skips  recomputat xon  ol  the 
stiffness.  Note  this  when  numbering  the  beams  to  obtain  maximum  efficiency. 


IV. 2. 4 


IV.  ELEMENT  DATA  (continued) 

TYPE  3 - PLANE  STRESS  MEMBRANE  ELEMENTS 

Quadrilateral  (and  t riangular) element s can  be  used  for  plane 
stress  membrane  elements  of  specified  thickness  which  are  oriented  in 
an  arbitrary  plane.  All  elements  have  temperature-dependent  orthotropic 
material  properties.  Incompatible  displacement  modes  can  be  included  at 
the  element  level  in  order  to  improve  the  bending  properties  of  the 
elements . 


A general  quadrilateral  element  is  shown  below: 


Z 


A local  element  coordinate  system  is  defined  by  a u-v  system.  The  v-axis 
coincides  with  the  I-J  side  of  the  element.  The  u axis  is  normal  to  the 
v-axis  and  is  in  the  plane  defined  by  nodal  points  I,  J and  L.  Node  K 
must  be  in  the  same  plane  if  the  element  stiffness  calculations  are  to 
be  correct.  The  following  sequence  of  cards  define  the  input  data  for 
a set  of  TYPE  3 elements. 


Ar  Control  Card  (615) 


Columns  1 - 5 

6-10 
11  - 15 
16  - 20 

30 


The  number  3 

Total  number  of  plane  stress  elements 
Number  of  material  property  cards 
Maximum  number  of  temperature  points  for  any 
one  material;  see  Section  B below. 

Non-zero  numerical  punch  will  suppress  the 
introduction  of  incompatible  displacement 
modes . 


B . Material  Property  Information 


Orthotropic,  temperature-dependent  material  properties  are 
possible.  For  each  different  material, the  following  group  of 
cards  must  be  supplied. 


IV.  ELEMENT  DATA  (continued) 


1*  Material  Property  Card  (2I5,3F10.0) 


Columns  1 - 5 

6-10 


11  - 20 


21 

31 


30 

40 


Material  identification  number 
Number  of  different  temperatures  for  which 
properties  are  given.  If  this  field  is 
left  blank,  the  number  is  taken  as  one. 
Weight  density  of  material  (used  to 
calculate  gravity  loads) 

Mass  density  (used  to  calculate  mass  matrix) 
Angle  p in  degrees,  measured  counter- 
clockwise from  the  v-axis  to  the  n-axis. 

K 


The  n-s  axes  are  the  principal  axes  for  the  ort hot ropic  material. 
Weight  and  mass  densities  need  be  listed  only  if  gravity  and 
inertia  loads  are  to  be  considered. 


2. 


Two  cards 

for 

each 

temperature : 

Card  1 : 

(8F10.0) 

Columns 

1 - 

10 

Tempe  rature 

11  - 

20 

Modulus  of  Elasticity  - E 

21  - 

30 

Modulus  of  Elasticity  - E 

31  - 

40 

Modulus  of  Elasticity  Et 

41  - 

50 

Strain  Ratio  “ i. 
Strain  Ratio  - 

51  - 

60 

61  - 

70 

Strain  Ratio  - vgt 
Shear  Modulus  - Gns 

71  - 

80 

IV. 3.2 


IV.  ELEMENT  DATA  (continued) 


Card  2:  (3F10.0) 


Columns  1-10 

Coefficient 

of 

thermal 

expansion  - 

O' 

11  - 20 

Coefficient 

of 

thermal 

expansion  - 

n 

CC 

21  - 30 

Coefficient 

of 

thermal 

expansion  - 

All  material  constants  must  always  be  specified.  Fbr  plane 
stress,  the  program  modifies  the  constitutive  relations  to 
satisfy  the  condition  that  the  normal  stress  equals  zero. 

C.  Element  Load  Factors  (5F10.0) 


Four  cards  are  used 

to  define 

the 

element 

load  cases  A,  B,  C 

and  D as 
load  s . 

f ract ion 

of 

the  basic 

thermal,  pressure  and  acceleration 

First 

card,  load 

case  A:  Second  card, 

load  case  B,  etc. 

Columns  1 - 

10 

Fraction 

of 

thermal 

load 

11  - 

20 

Fraction 

of 

pressure 

load 

21  - 

30 

Fraction 

of 

gravity 

in  X-direction 

31  - 

40 

Fract ion 

of 

gravity 

in  Y-direction 

41  - 

50 

Fraction 

of 

gravity 

in  Z-direction 

D.  Element  Cards  (61  5 , 2 FlO  . 0 , 21 5 , FlO  . 0) 

One  card  per  element  must  be  supplied  (or  generated)  with  the 
following  information: 


Columns  1 - 5 Element  number 


6 

- 

10 

Node  I 

11 

- 

15 

Node  J 

16 

- 

20 

Node  K 

21 

~ 

25 

Node  L (Node  L must  equal  Node 
triangular  elements) 

K for 

26 

- 

30 

Material  identification  number 

31 

— 

40 

Reference  temperature  for  zero 
within  element 

stresses 

41 

- 

50 

Normal  pressure  on  I-J  side  of 

element 

51 

- 

55 

Stress  evaluation  option  "n" 

56 

- 

60 

Element  data  generator  ’V 

61 

- 

70 

Element  thickness 

NOTES/ 

(1)  Element  Data  Generation  - Element  cards  must  be  in  element  number 
sequence.  If  cards  are  omitted,  data  for  the  omitted  elements  will 
be  generated.  The  nodal  numbers  will  be  generated  with  respect  to  the 
first  card  in  the  series  as  follows: 


I 

n 


I 

n- 


1 


+ k 


J 

n 


n-  1 


+ k 


IV.  ELEMENT  DATA  (continued) 


L = L , + k 
n n- 1 

All  other  element  information  will  be  set  equal  to  the  information  on 
the  last  card  read.  The  data  generation  parameter  "kM  is  specified 
on  that  card. 

(2)  Stress  Print  Option  - See  element  type  4 

(3)  Thermal  Data  - See  element  type  4 

(4)  Use  of  Triangles  - See  element  type  4 

(3)  Use  of  Incompatible  Modes  - See  element  type  4 


IV.  ELEMENT  DATA  (continued) 

TYPE  4 - TWO-DIMENSIONAL  FINITE  ELEMENTS 


P 


as  : 

Z-axis . 

Care  must 
types  of 

(ii)  Plane  strain  elements  of  unit  thickness  in  the  Y-Z  plane. 

(iii)  Plane  stress  elements  of  specified  thickness  in  the  Y-Z  plane. 

All  elements  have  temperature-dependent  orthotropic  material 
properties.  Incompatible  displacement  modes  can  be  included  at  the 
element  level  in  order  to  improve  the  bending  properties  of  the  element. 

A general  quadrilateral  element  is  shown  below: 


Quadrilateral  (and  triangular)  elements  can  be  used 

(i)  Axisymmetric  solid  elements  symmetrical  about  the 
The  radial  direction  is  specified  as  the  Y-axis, 
be  exercised  in  combining  this  element  with  other 
elements 


A.  Control  Card  (615) 

Columns  1 - 5 The  number  4 

6-10  Total  number  of  elements 
11  - 15  Number  of  different  materials 

16  - 20  Maximum  number  of  temperature  cards  for  any  one 
material  - see  Section  B below. 

{0  for  axisymmetric  analysis 
1 for  plane  strain  analysis 
2 for  plane  stress  analysis 
30  Non-zero  numerical  punch  will  suppress  the 

introduction  of  incompatible  displacement  modes. 
Incompatible  modes  cannot  be  used  for  triangular 
elements  and  are  automatically  suppressed. 


IV.  4.1 


IV.  ELEMENT  DATA  (continued) 


B . Material  Property  Information 

Orthotropic,  temperature-dependent  material  properties  are 
possible.  For  each  different  material  the  following  group 
of  cards  must  be  supplied. 


1 . Material  Property  Card  (215 , 3F10 . 0) 


Columns  1 
6 


11 

21 

31 


5 Material  identification  number 
10  Number  of  different  temperature  for  which 
properties  are  given.  If  this  field  is 
left  blank,  the  number  is  taken  as  one. 

20  Weight  density  of  material  (used  to  calcu- 
late gravity  loads) 

30  Mass  density  (used  to  calculate  mass  matrix) 
40  Angle  (3  in  degrees,  measured  counter- 
clockwise from  the  v-axis  to  the  n-axis. 


PRINCIPAL  MATERIAL  AXES 

The  n-s  axes  are  the  principal  axes  for  the  orthotropic 
material.  Weight  density  is  needed  only  if  gravity  and 
inertia  loads  are  to  be  considered, 

2 . Two  cards  for  each  temperature: 


Card  1:  (8F10.0) 


Columns  1 - 

10 

Temperature 

11  - 

20 

Modulus  of  elasticity 

21  - 

30 

Modulus  of  elasticity 

31  - 

40 

Modulus  of  elasticity 

41  - 

50 

Strain  ratio 

51  - 

60 

Strain  ratio 

61  - 

70 

Strain  ratio 

71  - 

80 

Shear  modulus 

En 

Es 


ns 

Hit 

Jst 


IV. 4. 2 


IV.  ELEMENT  DATA  (continued) 


Card  2:  (3F10.0) 

Columns  1 - 10  Coefficient  of  thermal  expansion  - cv 

11  - 20  Coefficient  of  thermal  expansion  - <y^ 

21  - 30  Coefficient  of  thermal  expansion  - 

All  material  constants  must  always  be  specified.  In  plane  stress, 

the  program  modifies  the  constitutive  relations  to  satisfy  the 
condition  that  the  normal  stress  o^.  equals  zero. 

C . Element  Load  Factors 

Four  cards  are  used  to  define  the  element  load  cases  A,  B,  C 
and  D as  fraction  of  the  basic  thermal,  pressure  and  accelera- 
tion loads. 

First  card,  load  case  A;  Second  card,  load  case  B;  etc. 


1 - 

10 

Fraction 

of 

thermal 

load 

11  - 

20 

Fract ion 

of 

pressure 

load 

21  - 

30 

Fraction 

of 

gravity 

in  X-direction 

31  - 

40 

Fraction 

of 

gravity 

in  Y-direction 

41  - 

50 

Fraction 

of 

gravity 

in  Z-direction 

D.  Element  Cards  (615 , 2F10 . 0 , 21 5 , FlO  . 0) 

One  card  per  element  must  be  supplied  (or  generated)  with  the 
following  in format  ion : 

Columns  1 - 5 Element  number 

6-10  Node  I 
11  - 15  Node  J 

16  - 20  Node  K 

21  - 25  Node  L (Node  L must  equal  Node  K for 
triangular  elements) 

26  - 30  Material  identification  number 
31  - 40  Reference  temperature  for  zero  stresses 
within  element 

41  - 50  Normal  pressure  on  I-J  side  of  element 

51  - 55  Stress  evaluation  option  "n" 

56  - 60  Element  data  generator  "k" 

61  - 70  Element  thickness  (For  plane  strain  set 

. equal  to  1.0  by  program) 

NOTES/  J F 

(1)  Element  Data  Generation  - Element  cards  must  be  in  element  number 
sequence.  If  cards  are  omitted  the  omitted  element  data  will  be 
generated.  The  nodal  numbers  will  be  generated  with  respect  to  the 
first  card  in  the  series  as  follows: 


IV. 4. 3 


IV.  ELEMENT  DATA  (continued) 


I 

n 


I 

n- 


1 


+ k 


J 

n 


J 

n- 


1 


+ k 


K 

n 


= K 


n-1 


+ k 


All  other  element  information  will  be  set  equal  to  the  information 

on  the  last  card  read.  The  data  generation  parameter  k is  given  on  that 

card. 


(2)  Stress  Print  Option  - The  following  description  of  the  stress  print 

option  applies  to  both  element  types  3 and  4.  The  value  of  the  stress 
print  option  "n"  can  be  given  as  1,  0,  8,  16  or  20. 


0 

4 

d 


= origin  of  natural  s-t  coordinates  (Fig.  5-2).  Points  1,  2,  3 
are  midpoints  of  sides.  The  points  at  which  stresses  are  output 
epend  on  the  value  of  n as  described  in  the  following  table. 


and 


IV. 4. 4 


IV.  ELEMENT  DATA  (continued) 


The  stresses  at  0 are  printed 
For  element  type  3,  side  I-J 
plane  6f  the  element.  For  el 
parallel  to  the  global  Y-Z  a* 


COORDINATES 


LOCAL  AND  GLOBAL 
Y-Z 


IV.  ELEMENT  DATA  (continued) 

Por  both  element  types  3 and  4 the  stresses  at  each  edge  midpoint  are 
output  in  a rectangular  n-p  coordinate  system  defined  by  the  outward 
normal  to  the  edge  (n  axis)  and  the  edge  (p  axis).  The  positive  p 
axis  for  points  1,  2,  3 and  4 is  from  L to  I , J to  K , I to  J and  K to  L 
respectively  (positive  direction  is  counterclockwise  about  element). 


/ COORDINATE  SYSTEMS 
j FOR  OUTPUT  OF 
EDGE  STRESSES 


POSITIVE  STATE 
OF  STRESS  AT 
THE  MIDPOINT 
OF  A SIDE 


IV. 4. 6 


IV.  ELEMENT  DATA  (continued) 

The  stresses  for  an  element  are  output  under  the  following  headings: 
Sll , S22 , S12 , S33,  S-MAX,  S-MIN,  ANGLE.  The  normal  stresses  Sll 
and  S22  and  the  shear  stress  S12  are  as  described  above.  S-MAX  and 
S-MIN  are  the  principal  stresses  in  the  plane  of  the  element  and  S33 
is  the  third  principal  stress  acting  on  the  plane  of  the  element. 

ANGLE  is  the  angle  in  degrees  from  (1)  the  local  y axis  at  point  0, 
or  (2)  the  n axis  at  the  midpoints,  to  the  axis  of  the  algebraically 
largest  principal  stress. 

For  triangular  elements  the  stress  print  option  is  as  described 
above  except  that  n =20  is  not  valid.  If  n =20  is  input,  n will 
be  set  to  16  by  the  program. 

(3)  Thermal  Data  - Nodal  temperatures  as  specified  on  the  nodal  point  data 
cards  are  used  by  element  types  3 and  4 in  the  following  two  ways: 

(1)  Temperature-dependent  material  properties  are  approximated  by 
interpolating  (or  extrapolating)  the  input  material  properties 
at  the  temperature  TQ  corresponding  to  the  origin  of  the  local 
s-t  coordinate  system  (see  Fig.  5.2  for  description  of  local 
element  coordinates).  The  material  properties  throughout  the 
element  are  assumed  constant  corresponding  to  this  temperature. 


(2)  For  computation  of  nodal  loads  due  to  thermal  strains  in  the 

element  a bilinear  interpolation  expansion  for  the  temperature 
change  AT  (s,t)  is  used. 

4 

AT  (s, t)  = Z h.  (s, t)  T.  - T 
i=i  1 1 r 

where  T.  are  the  nodal  temperatures  specified  on  the  joint 
data  cards,  Tr  is  the  reference  stress  free  temperature  and 
h^  (s,t)  are  the  interpolation  functions  given  by  Eq . 5.7. 


IV. 4. 7 


IV.  ELEMENT  DATA  (continued) 


(4)  Use  of  Triangles  - In  general,  the  elements  are  most  effective  when 
they  are  rectangular , i.e,  the  elements  are  not  distorted.  There- 
fore, regular  and  rectangular  element  mesh  layouts  should  be  used  as 
much  as  possible.  In  particular,  the  triangle  used  is  the  constant 
strain  triangle;  and  it  should  be  avoided,  since  its  accuracy  is 

not  satisfactory. 

(5)  Use  of  Incompatible  Modes  - Incompatible  displacement  modes  have 
been  found  to  be  effective  only  when  used  in  rectangular  elements. 
They  should  always  be  employed  with  care.  Since  incompatible  modes 
are  used  for  all  elements  of  a group  it  is  recommended  to  use 
separate  element  groups  for  elements  with  incompatible  modes  and 
elements  without  incompatible  modes,  respectively.  (See  Section  II 
note  (2)). 


IV.  ELEMENT  DATA  (continued) 

TYPE  5 - THREE-DIMENSIONAL  SOLID  ELEMENTS  (EIGHT  NODE  BRICK) 

General  three-dimensional,  eight-node,  isoparametric  elements  with 
three  translational  degrees  of  freedom  per  node  are  identified  by  the  number 
5.  Isotropic  material  properties  are  assumed.  The  element  load  cases  (A, 

B,  C and  D)  are  defined  as  a combination  of  surface  pressure,  hydrostatic 
loads,  inertia  loads  in  three  directions  and  thermal  loads.  The  six  com- 
ponents of  stress  and  three  principal  stresses  are  computed  at  the  center 
of  each  element.  Also,  surface  stresses  are  evaluated.  Nine  incompatible 
displacement  modes  are  assumed  in  the  formation  of  element  stiff nes  matrices. 
For  8-node  elements  without  incompatible  modes  use  element  type  8. 

A.  Control  Card  (415) 

Columns  1 - 5 The  number  5 

6-10  Number  of  8-node  solid  elements 
11  - 15  Number  of  different  materials 
16  - 20  Number  of  element  distributed  load  sets 

B.  Material  Property  Cards  (I5,4Fl0.0)  One  card  for  each 
different  material 

Columns  1-5  Material  identification  number 

6-15  Modulus  of  elasticity  (only  elastic, 
isotropic  materials  are  considered) 

16  - 25  Poisson's  ratio 

26  - 35  Weight  density  of  material  (for  calculation 
of  gravity  loads  or  mass  matrix) 

36  - 45  Coefficient  of  thermal  expansion 

c.  Distributed  Surface  Loads  (215 ,2Fl0.2 , 15)  One  card  is  required 
for  each  unique  set  of  uniformly  distributed  surface  loads 
and  for  each  reference  fluid  level  for  hydrostatically  varying 
pressure  loads.  See  notes  (4)  and  (5) for  sign  convention. 

Columns  1 - 5 Load  set  identification  number 

6-10  LT  (load  type) 

LT  - 1 if  this  card  specifies  a uniformly 
distributed  load. 

LT  = 2 if  this  card  specifies  a 
hydrostatically  varying  pressure. 

11-20  P 

If  LT  = 1,  P is  the  magnitude  of  the 
uniformly  distributed  load 

If  LT  = 2,  P is  the  weight  density  of  the 
fluid  causing  the  hydrostatic  pressure 
21-30  Y 

If  LT  = 1,  leave  blank 

If  LT  = 2,  Y is  the  global  Y coordinate 
of  the  surface  of  fluid  causing  hydrostatic 
pressure  loading 

31  - 35  Element  face  number  on  which  surface  load 
acts.  Face  numbers  are  from  1 to  6 as 

IV. 5.1 


IV,  ELEMENT  DATA  (continued) 


described  in  note  (5)  for  uniformly 
distributed  loads  and  can  be  only  faces 
2,  4 or  6 for  hydrostatically  varying 
pressures . 

D,  Acceleration  due  to  gravity  (FlO.2) 

Columns  1-10  Acceleration  due  to  gravity  (for  calculation 
of  mass  matrix) 


E,  Element  Load  Case  Multipliers  (5  cards  of  4F10.2) 

Multipliers  on  the  element  load  cases  are  scaling  factors 
in  order  to  provide  flexibility  in  modifying  applied  loads. 

Card  1 : Columns  1-10 

11  - 20 
21  - 30 
31  - 40 

PA  is  a factor  used  to  scale  the  complete  set  of  distributed 
surface  loads.  This  scaled  set  of  loads  is  assigned  to 
element  load  case  A.  Note  that  zero  is  a valid  multiplier. 
PB,  PC  and  PD  are  similar  to  PA  except  that  scaled  loads 
are  assigned  to  element  load  cases  B,  C and  D respectively. 
For  the  majority  of  applications  these  factors  should  be 
1.0 


Pressure  load 
multipliers 


Card  2 : 

Columns  1 

- 10 

TA  } 

11 

- 20 

TB  f Thermal  load 

21 

- 30 

TC  / multipliers 

31 

- 40 

TD  j 

TA  is  a factor  used  to  scale  the  complete  set  of  thermal 
loads.  The  scaled  set  of  loads  are  then  assigned  to  element 
load  case  A.  TB,  TC  and  TD  are  similar  and  refer  to  element 
load  cases  B,  C and  D respectively. 


Card 

3 : 

Columns 

1 

- 

10 

GXA 

11 

- 

20 

GXB 

21 

- 

30 

GXC 

31 

- 

40 

GXD 

Card 

4 : 

Columns 

1 

— 

10 

GYA 

11 

- 

20 

GYB 

21 

- 

30 

GYC 

31 

- 

40 

GYD 

Card 

5 : 

Columns 

1 

— 

10 

GZA 

11 

- 

20 

GZB 

21 

- 

30 

GZC 

31 

- 

40 

GZD 

) 

( 


Gravity  load 
multipliers  for  + X 
global  direction 


Gravity  load 
multipliers  for  + Y 
global  direction 


IV. 5. 2 


Gravity  load 
multipliers  for  + Z 
global  direction 


IV.  ELEMENT  DATA  (continued) 


Gravity  loads  are  computed  from  the  weight  density  of  the 
material  and  from  the  geometry  of  the  element.  GXA  is  a 
multiplier  which  reflects  the  location  of  the  gravity  axis 
and  any  load  factors  used.  The  program  computes  the  weight 
of  the  element,  multiplies  it  by  GXA  and  assigns  the 
resulting  loads  to  the  + X direction  of  element  load  case  A. 
Consequently  GXA  is  the  product  of  the  component  of  gravity 
along  the  + X global  axis  (from  - 1.0  to  1.0)  and  any  desired 
°ad  factor.  GXB,  GXC  and  GXD  are  similar  to  GXA  and  refer 
to  element  load  cases  B,  C and  D respectively.  GYA  and  GZA 
refer  to  the  global  Y and  Z directions  respectively. 

F*  Element  Cards  (1215 ,412 ,211 , F10.2) 


Columns  1 - 5 

6-10 
11  - 15 
16  - 20 
21  - 25 
26  - 30 
31  - 25 
36  - 40 
41  - 45 
46  - 50 
51  - 55 
56  - 60 
61  - 62 
63  - 64 
65  - 66 
67  - 68 


69  - 70 
71  - 80 


Element  number 


Global  node  point 
numbers  corresponding 
to  element  nodes 

(See  note  (3)) 


1 

2 

3 

4 

5 

6 

7 

8 


Integration  Order 
Material  Number 
Generation  Parameter  (INC) 

LSA  is  the  distributed  surface 
load  set  identification  number 
of  the  distributed  load  acting 
on  this  element  to  be  assigned 
to  element  load  case  A.  LSB  , LSC 
and  LSD  refer  to  element  load  cases 
B,  C and  D respectively 
Face  numbers  for  stress  output 
Stress-free  element  temperature 


LSA  \ 
LSB  I 
LSC  ( 
LSD  ) 


NOTES/ 


(1)  Element  Generation 


1.  Element  cards  must  be  in  ascending  order 

2.  Generation  is  possible  as  follows: 

If  a series  of  element  cards  are  omitted, 

a.  Nodal  point  numbers  are  generated  by  adding  INC  to 
those  of  the  preceding  element.  (If  omitted,  INC 
is  set  equal  to  1.) 

b.  Same  material  properties  are  used  as  for  the 
preceding  element. 

c.  Same  temperature  is  used  for  succeeding  elements. 


IV.  5.3 


I\  . ELEMENT  DATA  (continued) 


d.  If  on  first  card  for  the  series  the  integration 
order  is  : 

>0  Same  value  is  used  for  succeeding  elements. 

= 0 A new  element  stiffness  is  not  formed. 

Element  stiffness  is  assumed  to  be  identical 
to  that  of  the  preceding  element. 

<0  Absolute  value  is  used  for  the  first  element 
of  the  series,  and  the  same  element  stiffness 
is  used  for  succeeding  elements. 

e.  If  on  first  card  for  the  series,  the  distributed 
load  number  (for  any  load  case)  is: 

>0  Same  load  is  applied  to  succeeding  elements. 
<0  The  load  case  is  applied  to  this  element  but 
not  to  succeeding  elements  in  the  series. 

3,  Element  card  for  the  last  element  must  be  supplied. 

(2)  Integration  Order 


Computation  time  (for  element  stiffness)  increases  with 
the  third  power  of  the  integration  order.  Therefore,  the 
smallest  satisfactory  order  should  be  used.  This  is  found 
to  be  : 

2 for  rectangular  element 

3 for  skewed  element 

1 n,ay  be  used  if  element  is  extremely  distorted  in  shape, 
but  not  recommended. 

Mesh  should  be  selected  to  give  ”rec t angular"  elements  as  far 
as  possible. 


(3)  Element  Coordinate  System 


Local  element  coordinate  system  is  a natural  system 
this  element  in  which  the  element  maps  onto  a cube. 


for 

Local 


IV.  ELEMENT  DATA  (continued) 


(4)  Iden t if icat ion  of  Element  Faces 


Element  faces  are  numbered  as  follows: 


Face  1 corresponds  to  + a 

2 corresponds  to  - a 

3 corresponds  to  + b 

4 corresponds  to  - b 

5 corresponds  to  + c 

6 corresponds  to  - c 

0 corresponds  to  the 


direction 
direction 
d irect ion 
direction 
di  rection 
direction 
center  of  the  element 


Faces  1,3 , 5 are 
positive  faces 

Faces  2,4,6  are 
negative  faces 


(5)  Distributed  Surface  Loads 


Two  types  of  surface  loadings  may  be  specified;  load 
type  1 (LT  = 1) , uniformly  distributed  surface  load  and 
load  type  2 (LT  = 2),  hydrostatically  varying  surface 
pressure  (but  not  surface  tension) . Both  loading  types  are 
for  loads  normal  to  the  surface  and  do  not  include  surface 
shears.  Surface  loadings  that  do  not  fall  into  these 
categories  must  be  input  as  nodal  loads  on  the 
concentrated  load  data  cards  (see  Section  V) . 


( 1 ) LT  = 1 : A positive  surface  load  acts  in  the  direc- 

tion of  the  outward  normal  of  a positive  element  face  and 
along  the  inward  normal  of  a negative  element  face  as 
shown  in  the  following  diagram. 


POSITIVE  SURFACE  LOADING  P 


If  the  uniformly  distributed  surface  loading  P is  input  as 
a positive  quantity  then  it  describes  pressure  loading  on 
faces  2,  4 or  6 and  tensile  loading  on  faces  1,  3 or  5. 

If  P is  input  as  a negative  quantity  then  it  describes 
tensile  loading  on  faces  2,  4 or  6 and  pressure  on  faces 
1 , 3 or  5 . 


IV. 5. 5 


IV.  ELEMENT  DATA  (continued) 


(2)  LT  = 2:  A hydrostatically  varying  surface  pressure 

on  element  faces  2,  4 or  6 can  be  specified  by  a reference 
fluid  surface  and  a fluid  weight  density  y as  input.  Only 
one  hydrostatic  surface  pressure  card  need  be  input  in 
order  to  specify  a hydrostatic  loading  on  the  complete 
structure.  The  consistent  nodal  loads  are  calculated 
by  the  program  as  follows.  At  each  numerical  integration 
point  "i"  on  an  element  surface  the  pressure  PA  is  calcu- 
lated from 

P.  - y (Y . - Y .) 
l l ref 

where  Y.  is  the  global  Y coordinate  of  the  point  in  question 
and  Yref  specifies  the  fluid  surface  assuming  gravity  acts 
along  the  -Y  axis 


If  P >0,  corresponding  to  surface  tension,the  contri- 
bution is  ignored.  If  an  element  face  is  such  that 

Yi  > Yref  for  a11  1 (16  inteeration  Points  are  used  bY 
program)  then  no  nodal  loads  will  be  applied  to  the  element. 

If  some  p.  > 0 and  some  Pi  < 0 for  a particular  face, then 
approximate  nodal  loads  are  obtained  for  the  partially 
loaded  surface. 
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IV.  ELEMENT  DATA  (continued) 


(6) . Thermal  Loads 

Thermal  loads  are  computed  assuming  a constant 
temperature  increase  AT  throughout  the  element. 


Tavg  ~ the  average  of  the  8 nodal  point 
temperatures  specified  on  nodal 
point  data  cards 

To  “ stress  free  element  temperature 
specified  on  the  element  card. 

Element  Load  Cases 


Element  load  case  A consists  of  all  the  contributions 
from  distributed  loadings,  thermal  loadings  and  gravity 
loading  for  all  the  elements  taken  collectively. 


Load  case  A = £ (PA  x pressure  loading 

+ TA  x thermal  loading 
+ GXA  X gravity  X loading 
+ GYA  X gravity  Y loading 
+ GZA  X gravity  Z loading) 

Element  load  case  A for  the  set  of  three  dimensional  solid 
elements  is  added  to  element  load  case  A for  the  other 
element  types  in  the  analysis.  The  treatment  of  element 
load  cases  B,  C and  D is  analogous  to  that  of  element 
load  case  A.  The  loading  cases  for  the  structure  are 
obtained  by  adding  linear  combinations  of  element  load 
cases  A,  B,  C and  D to  the  nodal  loads  specified 
on  the  joint  data  cards. 

Output  of  Element  Stresses 

1.  At  the  centroid  of  the  element,  stresses  are  referred  to 
the  global  axes.  Three  principal  stresses  are  also 
presented . 


2.  At  the  center  of  an  element  face,  stresses  are  referred 
to  a set  of  local  axes  (x,y,z) . These  local  axes 
are  individually  defined  for  each  face  as  follows: 

Let  nodal  points  I,  J,  K and  L be  the  four  corners 
of  the  element  face.  Then 

x is  specified  by  LI  - JK,  where  LI  and  JK  are  midpoints 
of  sides  L-I  and  J-K, 

z is  normal  to  x and  to  the  line  joining  midpoints  IJ  and 
KL. 

y is  normal  to  x and  z,  to  complete  the  right-handed  system. 
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IV.  ELEMENT  DATA  (continued) 


Z 


The  corresponding  nodal  points  I,  J,  K and  L in  each  face 
are  given  in  the  table. 


FACE 

NODAL 

POINTS  ! 

I 

J 

K 

L 

1 

1 

2 

6 

5 

2 

4 

3 

7 

8 

3 

3 

7 

6 

2 

4 

4 

8 

5 

1 

5 

8 

5 

6 

7 

6 

4 

1 

2 

3 

Two  surface  principal  stresses  and  the  angle  between  the 
algebraically  largest  principal  stress  and  the  local  x 
axis  are  printed  with  the  output.  It  is  optional  to  choose 
one  or  two  locations  of  an  element  where  stresses  are  to 
be  computed.  In  the  output,  "face  zero”  designates  the 
centroid  of  the  element. 


IV. 5. 8 


IV.  ELEMENT  DATA  (continued) 

TYPE  6 - PLATE  AND  SHELL  ELEMENTS  (QUADRILATERAL) 

A.  Control  Card  (315) 

Columns  1 — 5 The  number  6 

6-10  Number  of  shell  elements 
11  - 15  Number  of  different  materials 

B.  Material  Property  Information 

Anisotropic  material  properties  are  possible.  For 
each  different  material,  two  cards  must  be  supplied, 

Card  1:  (I10,20X,4F10.0) 


Columns 


Material  identification  number 
Mass  density 

Thermal  expansion  coefficient 
Thermal  expansion  coefficient  ot^ 
Thermal  expansion  coefficient  a 


Card  2:  (6F10.0) 

Columns  1-10  1 


Elasticity  element 
Elasticity  element 
Elasticity  element 
Elasticity  element 
Elasticity  element 
Elasticity  element 


Element  Load  Multipliers  (5  cards] 


Elements  in  plane  stress 
material  matrix  [Cl 

f8=\  ftoc  Cxy  c*sl  f6** 

(ayy  r c*y  cyy  cys 

\Txs  / Cxs  Cys  GxvJ  v xy 


Card  1:  (4F10.0) 

Columns  1-10  Distributed  lateral  load  multiplier  for  load  case  A 

11  - 20  Distributed  lateral  load  multiplier  for  load  case  B 

21  - 30  Distributed  lateral  load  multiplier  for  load  case  C 

31  - 40  Distributed  lateral  load  multiplier  for  load  case  D 


Card  2:  (4F10.0) 

Columns  1-10  Temperature  multiplier  for  load  case  A 

11  - 20  Temperature  multiplier  for  load  case  B 

21  - 30  Temperature  multiplier  for  load  case  C 

31  - 40  Temperature  multiplier  for  load  case  D 

Card  3:  (4F10.0) 

Columns  1-10  X-direction  acceleration  for  load  case  A 

11  - 20  X-direction  acceleration  for  load  case  B 

21  — 30  X— direction  acceleration  for  load  case  C 

31  - 40  X-direction  acceleration  for  load  case  D 
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IV.  ELEMENT  DATA  (continued) 


Card  4:  (4F10.0)  Same  as  Card  3 for  Y-direction 

Card  5:  (4F10.0)  Same  as  Card  3 for  Z-direction 


D.  Element  Cards  (8I5,Fl0.0) 


One  card 
Columns 


for 

each 

element 

1 - 

5 

Element  number 

6 - 

10 

Node  I 

11  - 

15 

Node  J 

16  - 

20 

Node  K 

21  - 

25 

Node  L 

26  - 

30 

Node  0 

31  - 

35 

Material  identification  (if  left  blank, 
taken  as  one) 

36  - 

40 

Element  data  generator  K 

41  - 

50 

Element  thickness  n 

51  - 

60 

Distributed  lateral  load  (pressure) 

61  - 

70 

Mean  temperature  variation  T from  the  reference 
level  in  undeformed  position 

71  - 

80 

Mean  temperature  gradient  across  the 

shell  thickness  (a  positive  temperature 
gradient  produces  a negative  curvature). 

NOTES/ 

(1)  Nodal  Points  and  Coordinate  Systems 

The  nodal  point  numbers  I,  J(  K and  L are  in  sequence  in  a 
counter-clockwise  direction  around  the  element.  The  local 
element  coordinate  system  (x , y,  z)  is  defined  as  follows: 

x Specified  by  LI  - JK,  where  LI  and  JK  are  midpoints  of 
sides  L-I  and  J-K. 

z Normal  to  x and  to  the  line  joining  midpoints  IJ  and  KL. 
y Normal  to  x and  z to  complete  the  right-handed  system. 

This  system  is  used  to  express  all  physical  and  kinematic 
shell  properties  (stresses,  strains,  material  law,  etc.), 
except  that  the  body  force  density  is  referred  to  the 
global  coordinate  system  (X,  Y,  Z) . 
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IV.  ELEMENT  DATA  (continued) 


Z 


J 


For  the  analyses  of  shallow  shells , rotational  constraints  normal 
to  the  surface  may  be  imposed  by  the  addition  of  boundary  elements  at 
the  nodes  (element  type  pi) . 

(2)  Node  0 

When  columns  26  - 30  are  left  blank,  mid-node  properties 
are  computed  by  averaging  the  four  nodes. 

(3)  Element  Data  Generation 

Element  cards  must  be  in  element  number  sequence.  If 
element  cards  are  omitted,  the  program  automatically 
generates  the  omitted  information  as  follows: 

The  increment  for  element  number  is  one 

i . e . NE . . = NE . +1 

l+l  l 

* 

The  corresponding  increment  for  nodal  number  is 


NIi+l 

= NIi 

+ 

K 

n 

NJi+l 

= NJi 

+ 

K 

n 

“i+l 

= NKi 

+ 

K 

n 

NLi+l 

= NL. 

l 

+ 

K 

n 

Material  identification,  element  thickness,  distributed 
lateral  load,  temperature  and  temperature  gradient  for 
generated  elements  are  the  same.  Always  include  the 
complete  last  element  card. 
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IV.  ELEMENT  DATA  (continued) 


(4)  Element  Stress  Calculations 


Output  are  moments  per  unit  length  and  membrane  stresses. 
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IV.  ELEMENT  DATA  (continued) 
f YPE  7 - BOUNDARY  ELEMENTS  ' 

This  element  is  used  to  constrain  nodal  displacements  to  specified 
values,  to  compute  support  reactions  and  to  provide  linear  elastic 
supports  to  nodes.  If  the  boundary  condition  code  for  a particular 
degree  of  freedom  is  specified  as  1 on  the  structure  nodal  point  data 
cards,  the  displacement  corresponding  to  that  degree  of  freedom  is 
zero  and  no  support  reactions  are  obtained  with  the  printout.  Alterna- 
tively, a boundary  element  can  be  used  to  accomplish  the  same  effect 
except  that  support  reactions  are  obtained  since  they  are  equal  to  the 
member  end  forces  of  the  boundary  elements  which  are  printed.  In 
addition  the  boundary  element  can  be  used  to  specify  non-zero  nodal 
displacements  in  any  direction  which  is  not  possible  using  the  nodal 
point  data  cards. 

The  boundary  element  is  defined  by  a single  directed  axis  through 
a specified  nodal  point,  by  a linear  extensional  stiffness  along  the 
axis  or  by  a linear  rotational  stiffness  about  the  axis.  The  boundary 
element  is  essentially  a spring  which  can  have  axial  displacement 
stiffness  and  axial  rotational  stiffness.  There  is  no  limit  to  the 
number  of  boundary  elements  which  can  be  applied  to  any  joint  to  produce 
the  desired  effects.  Boundary  elements  have  no  effect  on  the  size  of 
the  stiffness  matrix. 

INPUT  DATA 

A.  Control  Card  (215) 


Columns 


5 The  number  7. 

10  Total  number  of  boundary  elements, 


Element  Load  Multipliers  (4F10 .0) 


Columns 


1 - 

10 

Mult iplier 

for 

load 

case 

A 

11  - 

20 

Multiplier 

for 

load 

case 

B 

21  - 

30 

Mult iplier 

for 

load 

case 

C 

31  - 

40 

Multiplier 

for 

load 

case 

D 

Element  Cards  (8I5,3Fl0.0) 

One  card  per  element  (in  ascending  nodal  point  order)  except 
where  automatic  element  generation  is  used. 


Columns 


Node  N,  at  which  the  element  is  placed 
Node  I 

Node  J Leave  columns  11  - 25  blank 
Node  K if  only  node  I is  needed. 

Node  L 

Code  for  displacement 
Code  for  rotation 
Data  generator  Kn 

Specified  displacement  along  element  axis 
Specified  rotation  about  element  axis 
Spring  stiffness  (set  to  10^°  if  left  blank) 
for  both  extension  and  rotation. 


Leave  columns  11  - 25  blank 
if  only  node  I is  needed. 
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IV.  ELEMENT  DATA  (continued) 

NOTES/ 

(I ) Direction  of  boundary  element 

The  direction  of  the  boundary  element  at  node  N is  specified 
in  one  of  two  ways. 

(i)  A second  nodal  point  I defines  the  direction  of  the 
element  from  node  N to  node  I. 

(ii)  Four  nodal  points  I,  J,  K and  L specify  the  direction 

of  the  element  as  the  normal  to  the  plane  defined  by  two 
intersecting  straight  lines  (vectors  a and  £ , see  Fig.  below). 


n = axb 


rotational  constraint 

IN  THIN  SHELL  ANALYSIS 


The  four  points  I,  J,  K and  L need  not  be  unique.  A useful 
application  for  the  analysis  of  shallow  thin  shells  employs 
the  boundary  element  to  approximate  rotational  constraint 
about  the  surface  normal  as  shown  above. 

n is  given  by  the  vector  cross  product  n = a x b and  defines 
the  direction  of  the  boundary  element. 


Note  that  node  I in  case  (i)  and  nodes  I,  J,  K and  L in  case  (ii)  are 
used  only  to  define  the  direction  of  the  element  and  if  convenient  may 
be  any  nodes  used  to  define  other  elements.  However  'artificial  nodes' 
may  be  created  to  define  directions  of  boundary  elements.  These 
artificial  nodes'  are  input  on  the  nodal  point  data  cards 
with  their  coordinates  and  with  all  the  boundary  condition  codes 
specified  as  1 (one). 
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IV.  ELEMENT  DATA  (continued) 

It  should  be  noted  that  node  N is  the  structure  node  to  which  the 
boundary  element  is  attached.  In  case  (i),  a positive  displacement  moves 
node  N towards  node  I.  Correspondingly,  a positive  force  in  the  element 
means  compression  in  the  element.  In  case  (ii),  a positive  displacement 
moves  node  N into  the  direction  n (see  Fig.). 

(2)  Displacement  and  rotation  codes 

Displacement  code  = 1:  When  this  code  is  used,  the  displacement 

6,  specified  in  columns  41-50,  and  the  spring  stiffness  k,  specified 
in  columns  61-70,  are  used  by  the  program  in  the  following  way.  The 
load  P,  evaluated  from  P = k6,  is  applied  to  node  N in  the  direction 
node  N to  node  I in  case  (i)  and  into  direction  n in  case  (ii),  if  6 
is  positive.  If  k is  much  greater  than  the  stiffness  of  the  structure 
at  node  N without  the  boundary  element,  then  the  net  effect  is  to  produce 
a displacement  very  nearly  equal  to  6 at  node  N.  If  6 = 0,  then  P = 0 
and  the  stiff  spring  approximates  a rigid  support.  Note  that  the  load 
P will  contribute  to  the  support  reaction  for  nonzero  6.  The  boundary 
condition  codes  specified  on  the  structure  nodal  point  data  cards  must 
be  consistent  with  the  fact  that  a load  P is  being  applied  to  node  N 
to  effect  the  desired  displacement  (even  when  this  displacement  is 
zero)  . 


Rotation  code  = 1:  This  case  is  analogous  to  the  situation 

described  above.  A torque  T,  evaluated  from  T = k 0,  is  applied  to  node 
N about  the  axis  (direction)  of  the  element.  The  rotation  0 is  specified 
in  columns  51-60, 

(3)  Data  generator  K 
n 

When  a series  of  nodes  are  such  that: 

(i)  All  have  identical  boundary  elements  attached 

(ii)  All  boundary  elements  have  same  direction 

(iii) All  specified  displacements  and  rotations  are  identical 

(iv)  The  nodal  sequence  forms  an  arithmetic  sequence,  i.e.,  N, 

N + K , N + 2K  etc. , 
n n 

then  only  the  first  and  last  node  in  the  sequence  need  be  input.  The 
increment  K is  input  in  columns  36-40  of  the  first  card. 
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IV,  ELEMENT  DATA  (continued) 


(4)  Element  load  multipliers 


Each  of  the  four  possible  element  load  cases  A,  B,  C and  D 
associated  with  the  boundary  elements  consists  of  the  complete  set  of 
displacements  as  specified  on  the  boundary  element  cards  multiplied 
by  the  element  load  multiplier  for  the  corresponding  load  case.  As 
an  example,  suppose  that  displacement  of  node  N is  specified  as  1.0, 
spring  stiffness  as  1010  and  no  other  boundary  element  displacements 
are  specified.  Let  case  A multiplier  be  0,0  and  case  B multiplier  be 
2,0.  For  element  load  case  A the  specified  displacement  is  0.0  x 1.0  » 0.0 
while  that  for  B is  2.0  x 1.0  = 2.0,  Linear  combinations  of  element 
load  cases  A,  B,  C and  D for  all  types  of  elements  collectively  for  a 
particular  problem  are  specified  on  the  structure  element  load  multiplier 
cards.  As  far  as  the  boundary  element  is  concerned,  this  device  is 
useful  when  a particular  node  has  a support  displacement  in  one  load 
case  but  is  fixed  in  others. 

(5)  Recommendations  for  use  of  boundary  elements 


If  a boundary  element  is  aligned  with  a global  displacement 
direction,  only  the  corresponding  diagonal  element  in  the  stiffness 
matrix  is  modified.  Therefore,  no  stiffness  matrix  ill-conditioning 
results.  However,  when  the  boundary  element  couples  degrees  of 
freedom,  large  off-diagonal  elements  introduce  ill-conditioning  into 
the  stiffness  matrix  which  can  cause  solution  difficulties. 

In  the  analysis  of  shallow  shells  boundary  elements  with  stiffness 
a fraction  of  the  element  bending  stiffness  should  be  used  (say  less 
than  or  about  10%) . 

In  dynamic  analysis  'artificially  stiff11  boundary  elements  should 
not  be  used.  (See  note  (8)  in  Section  VII. A). 
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IV.  ELEMENT  DATA  (continued) 


TYPE  8 - VARIABLE-NUMBER-NODES  THICK  SHELL  AND  THREE-DIMENSIONAL  ELEMENTS 

A minimum  of  8 and  a maximum  of  21  nodes  are  used  to  describe 
a general  three  dimensional  isoparametric  element ; the  element  is  used 
to  represent  orthotropic,  elastic  media.  The  element  type  is  identified 
by  the  number  eight  (8).  Three  translational  degrees  of  freedom  are 
assigned  to  each  node,  and  at  least  the  eight  corner  nodes  must  be  input 
to  define  a hexahedron.  Input  of  nodes  9 to  21  is  optional;  the  figures 
below  illustrate  some  of  the  most  commonly  used  node  combinations. 

Element  load  cases  (A,B,C,...)  are  formed  from  combinations 
of  applied  surface  pressure,  hydrostatic  loads,  inertia  loads  in  the 
three  directions  X,Y,Z  and  thermal  loads.  Six  global  stresses  are 
output  at  up  to  seven  (7)  locations  within  the  element;  these  output 
locations  are  selected  by  means  of  appropriate  data  entries. 

Node  temperatures  input  in  Section  III  are  used  to  form  an 
average  element  temperature,  which  is  the  basis  of  material  property 
selection  for  the  element.  If  thermal  loads  are  applied,  node  tempera- 
tures are  used  to  establish  the  temperature  field  within  the  element, 
and  the  temperature  interpolation  functions  are  the  same  as  those 
assumed  to  represent  element  displacements. 

1.  Control  Card  (1015) 


notes 

columns 

variable 

entry 

5 

Enter  the  number  M8" 

6 - 

10 

NS0L21 

Number  of  solid  elements;  GE.l 

11  - 

15 

NUMMAT 

Number  of  different  materials;  GE.l 

(1) 

16  - 

20 

MAXTP 

Maximum  number  of  temperature  points 
used  in  the  table  for  any  material; 
EQ.0;  default  set  to  "l" 

(2) 

21  - 

25 

NORTHO 

Number  of  different  sets  of  material  axis 
orientation  data; 

EQ.0;  all  properties  are  defined  in 
the  X,Y,Z,  system 

(3) 

26  - 

30 

NDLS 

Number  of  different  distributed  load 
(i.e.,  pressure)  sets 

(4) 

31  - 

35 

MAXNOD 

Maximum  number  of  nodes  used  to  describe 
any  one  element  ; 

GE  . 8 and  LE.21 

EQ.0;  default  set  to  "21" 

(5) 

36  - 

40 

NOPSET 

Number  of  sets  of  data  requesting  stress 
output  at  various  element  locations; 
EQ.0;  centroid  output  only 
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IV.  ELEMENT  DATA  (continued) 


Control  Card  (1015)  (continued) 


notes  columns  variable  entry 

(6)  41  - 45  INTRS  Standard  integration  order  for  the  natural 

(r , s)  directions  ; 

GE.2  and  LE.4 

EQ.O;  default  set  to  "2" 


INTT  Standard  integration  order  for  the 

natural  (t) -direct ion  ; 

GE.2  and  LE.4 

EQ.O;  default  set  to  "2" 


NOTES/ 

(1)  The  variable  MAXTP  limits  the  number  of  temperature  points 
that  can  be  input  for  any  one  of  the  NUMMAT  material  sets; 
i.e.,  the  variable  NTP  in  Section  2 cannot  exceed  the  value 
of  MAXTP. 


(2)  NORTHO  specifies  the  number  of  cards  to  be  read  in  Section  3, 
and  if  omitted,  all  orthotropic  material  axes  are  assumed  to 
coincide  with  the  global  cartesian  axes  X,Y,Z. 

(3)  NDLS  specifies  the  number  of  card  pairs  to  be  read  in 
Section  4.  NDLS  must  be  a positive  integer  if  any  pressure 
loads  are  to  be  applied  to  solid  element  faces. 

(4)  MAXNOD  specifies  the  maximum  number  of  non-zero  node  numbers 
assigned  to  any  one  of  the  NS0L21  elements  input  in  Section  7. 
Locations  of  the  element fs  21  possible  nodes  are  shown  in 

the  figure  below  in  which  the  element  is  shown  mapped  into 
its  natural  r,s,t  coordinate  system.  The  eight  corner  nodes 
must  be  input  for  every  element,  and  nodes  9 to  21  are  input 
optionally.  If  MAXNOD  is  9 or  greater,  all  21  node  entries 
are  read  for  each  element  (Cards  2 and  3,  Section  7),  but 
only  the  first  MAXNOD  non-zero  entries  encountered  when 
reading  in  sequence  from  1 to  21  will  be  used  for  element 
description.  As  an  example,  for  the  16-17-  and  20-node  elements 
MAXNOD  has  values  of  16,  17,  20,  respectively. 


(5)  As  a means  of  controlling  the  amount  of  solution  output, 

stress  output  location  sets  are  defined  in  Section  5,  and  the 
total  number  of  these  output  requests  is  specified  by  the 
variable  NOPSET.  For  the  case  of  N0PSET.EQ.0,  no  data  is 
input  in  Section  5,  and  the  only  stress  output  produced  by 
the  program  is  at  the  element  centroid.  Otherwise,  stress 
output  can  be  requested  at  up  to  seven  (7)  locations  (selected 
from  a table  of  27  possible  locations)  by  means  of  the  data 
entries  given  in  Section  5. 
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IV.  ELEMENT  DATA  (continued) 
NOTES  (continued) 


(6)  The  entries  INTRS  and  INTT  control  the  number  of  integration 

points  to  be  used  in  numerical  evaluation  of  integrals  over  volumes 
in  the  (r,s)  and  (t ) —coordinate  directions*  respectively. 

When  solid  elements  are  used  to  represent  shell  structures, 
the  through-the-thickness  integrations  (i.e.,  in  the  natural 
^“ax:*-s  direction)  can  be  evaluated  less  accurately  than  those 
in-plane  (i.e.,  in  the  r,s  plane).  For  this  case  INTRS 
might  be  3 and  INTT  would  be  chosen  typically  as  2.  The 
entries  INTRS  and  INTT  are  standard  or  reference  values  and 
are  used  if  the  integration  order  entries  on  the  element 
cards  (Card  1,  Section  7)  are  omitted.  Non-zero  entries  for 
integration  order (s)  given  on  the  element  cards  over-ride  the 
standard  values  posted  on  this  card. 

2 . Material  Property  Cards 

Orthotropic,  temperature  dependent  material  properties 
are  allowed.  For  each  different  material  that  is  requested  on  the 
Control  Card,  the  following  set  of  data  must  be  supplied  (i.e.,  NUMMAT 
sets  total)  : 


a*  Material  identification  card  (2 15 ,2FlO . 0 , 6A6) 


notes  columns 


variable  entry 


(1) 

1 - 

5 

M 

6 - 

10 

NTP 

(2) 

11  - 

20 

WTDEN 

21  - 

30 

MASSD1 

31  - 66 


Material  identification  number; 

GE.l  and  LE. NUMMAT 

Number  of  different  temperatures  at 

which  properties  are  given; 

LE.MAXTP 

EQ.O;  default  set  to  "lu 

Weight  density  of  the  material  used  to 

computed  static  gravity  loads 

Mass  density  of  the  material  used  to 

compute  the  mass  matrix  in  a dynamic 

analysis ; 

EQ.O;  default  set  to  "WTDEN/386 .4 n 
Material  description  used  to  label  the 
output . 


NOTES/ 

(1)  Material  numbers  (M)  must  be  input 
beginning  with  "l"  and  ending  with 
repetitions  are  illegal. 


in  ascending  sequence 
'NUMMAT";  omissions  or 


(2)  Weight  density  is  used  to  compute  static  node  forces  due  to 
applied  gravity  loads;  mass  density  is  used  to  calculate 
element  mass  matrices  for  use  in  connection  with  a dynamic 
analysis . 
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IV.  ELEMENT  DATA  (continued) 


b.  Material  cards  (7F10 . 0 , 6F10 . 0) 

NTP  pairs  of  cards  are  input  in  order  of  algebraically 
increasing  value  of  temperature. 

First  Card 


notes  columns  variable  entry 


(1) 

(2) 


1-10 
11  - 20 
21-30 
31  - 40 
41  - 50 
51  - 60 
61  - 70 


Temperature,  T 


E11 

at 

Tn 

e22 

at 

Tn 

E33 

at 

Tn 

Vl2 

at 

Tn 

VI 3 

at 

Tn 

V23 

at 

Tn 

Second  Card 


notes  columns  variable  entry 


1 

11 

21 

31 

41 

51 


- 10 

g12 

at 

Tn 

- 20 

G13 

at 

Tn 

- 30 

G23 

at 

Tn 

- 40 

al 

at 

Tn 

- 50 

a2 

at 

Tn 

- 60 

a3 

at 

Tn 

NOTES/ 

(1) 


The  12  entries  following  the  temperature  value  Tn  are  physical 
properties  known  at  Tn . When  two  or  more  temperature  points 
describe  a material,  interpolation  based  on  average  element 
temperature  is  performed  to  establish  a property  set  for  the 
element.  Hence,  the  range  of  temperature  points  for  a material 
table  must  span  the  expected  range  of  average  element  tempera- 
tures for  all  elements  associated  with  the  material. 


(2)  The  12  constants  (E;q  ,E22  9 * ' # 1 **3^  are  defined  with  respect 
to  a set  of  axes  (X^,X2>X3)  which  are  the  principal  material 
directions  for  an  orthotropic,  elastic  medium.  The  stress- 
strain  relations  with  respect  to  the  (X1,X2»X3)  system  is 
written  as  follows  : 
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IV.  ELEMENT  DATA  (continued) 


"ell" 

i/En 

- yi2//E22 

- Vx3/E33 

0 

0 0 " 

"°ll" 

e22 

i/e22 

~^23//e33 

0 

0 0 

°22 

e33 

" V31/Ell 

" V32/E22 

1//E33 

0 

0 0 

°33 

Y12 

0 

0 

0 

1/G12 

0 0 

T12 

Y23 

0 

0 

0 

0 

1//C23  0 

T23 

_^3 1 

0 

0 

0 

0 

° 1/G13_ 

_T3i_ 

[ ATo1  ATcr2  ATo3  0 0 0]T 


where  £. . and  are  normal  strains  and  stresses  in  the 

directions;  Yjj  and  Tjj  are  shear  strains  and  stresses  on 
the  principal  material  planes;  are  the  coefficients  of  thermal 
expansion,  and  AT  is  the  increase  in  temperature  from  stress  free 
distributed  over  the  element  volume. 


3.  Material  Axes  Orientation  Sets  (415) 

If  NORTHO  is  zero  on  the  Control  Card,  skip  this  data 
section,  and  all  material  axes  (XlfX2»X3)  will  be  assumed  to  coincide 
with  the  global  cartesian  system  X,Y,Z.  Otherwise,  NORTHO  cards  must 
be  input  as  follows  : 


notes 

columns 

variable 

entry 

(1) 

1 - 

5 

M 

Identification  number ; 

GE.l  and  LE. NORTHO 

(2) 

6 - 

10 

NI 

Node  number  for  point  "i 

11  - 

15 

NJ 

Node  number  for  point  "j 

16  - 

20 

NK 

Node  number  for  point  "k 

NOTES/ 

(1)  Identification  numbers  (M)  must  be  input  in  increasing 
sequence  beginning  with  "l"  and  ending  with  "NORTHO". 

(2)  Orthotropic  material  axes  orientations  are  specified  by 
means  of  the  three  node  numbers  NI,NJ,NK.  For  the  special 
case  where  orthotropic  material  axes  coincide  with  the  global 
axes  (X,Y,Z),  it  is  not  necessary  to  input  data  in  this 
section;  see  Section  7,  note  (4).  Let  £i »£2fl3  be  the  three 
orthogonal  vectors  which  define  the  axes  of  material  orthotropy, 
then  their  directions  are  as  shown  below: 
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IV.  ELEMENT  DATA  (continued) 


Node  numbers  NI,NJ,NK  are  only  used  to  locate  points 
respectively,  and  any  convenient  nodes  may  be  used. 


4.  Distributed  Surface  Load  Data 


NDLS  pairs  of  cards  are  to  be  input  in  this  section  in 
order  of  increasing  set  number  (N) . These  data  describe  surface  loads 
acting  on  element  faces  and  may  be  prescribed  directly  in  terms  of 
face  corner  node  pressures  or  indirectly  by  means  of  a hydrostatic 
pressure  field. 


a.  Control  Card  (315) 


notes  columns  variable  entry 


(1)  1-5  N 

(2)  6-10  NFACE 

(3)  11  - 15  LT 


Load  set  identification  number; 

GE.l  and  LE.NDLS 

Element  face  number  on  which  this 
distributed  load  is  acting; 

GE . 1 and  LE . 6 
Load  type  code ; 

EQ.l;  prescribed  normal  pressure 
intensities 

EQ.2 ; hydrostatically  varying  pressure 
field 

default  set  to  "l" 


EQ.O  ; 


IV.  ELEMENT  DATA  (continued) 


NOTES/ 

(1)  The  surface  load  data  sets  established  in  this  section  are 
assigned  to  the  elements  in  Section  7. 

(2)  Hexahedra  have  six  quadrilateral  faces  each  uniquely  described 
by  four  node  numbers  at  the  corners  of  the  face.  The  face 
number  convention  established  for  elements  is  given  in  the 
Table  below. 

(3)  Two  types  of  surface  pressure  loads  may  be  applied  to  faces 
of  the  elements.  If  LT.EQ.O  (or  1),  a normal  pressure 
distribution  is  prescribed  directly  by  means  of  pressure 
intensities  at  the  face  corner  nodes.  If  LT.EQ.2,  the 
face  is  exposed  to  hydrostatic  pressure  due  to  fluid  head. 


FACE  NATURAL  CORNER  NODE  NUMBERS 

NUMBER  COORDINATES  ^ N2  N3  N4 


1 

(+1,  s, 

t) 

1 

4 

8 

5 

2 

(-1,  S, 

t) 

2 

3 

7 

6 

3 

( r, +1, 

t) 

1 

5 

6 

2 

4 

( r,-l, 

t) 

4 

8 

7 

3 

5 

( r,  s,+l) 

1 

2 

3 

4 

6 

( r,  s, 

-1) 

5 

6 

7 

8 

TABLE 

Corner  Node  Numbers  for 

the  Solid  Element  Faces 

b. 

Normal  Pressure  Data  (4F10.0) 

(LT.EQ.l,  only) 

notes 

columns 

variable 

ent  ry 

a) 

1 

- 10 

PI 

Pressure  at  face  node 

Ni 

(2) 

11 

- 20 

P2 

Pressure  at  face  node 

n2  ’ 

EQ.0;  default  set  to 

"pi" 

21 

- 30 

P3 

Pressure  at  face  node 

n3> 

EQ.0;  default  set  to 

"pi" 

31 

- 40 

P4 

Pressure  at  face  node 

n4; 

EQ.0;  default  set  to 

"pi" 
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IV.  ELEMENT  DATA  (continued) 

NOTES/ 

(1)  The  pressure  distribution  acting  on  an  element  face  is 

defined  by  specifying  intensities  Pl,P2,P3,P4  at  the  face 
corner  nodes  as  shown  below: 


The  face  corner  node  numbers  are  given  in  the  Table 
and  positive  pressure  tends  to  compress  the  volume  of 
the  element . 

The  variation  of  pressure  over  the  element  face,  p(a,b), 
is  given  as  : 

p (a  ,b)  = Plxh1  + P2Xh2  + P3xh3  + p4  >^4 

where 

h = (1/4)  (1+a)  (1+b) 

h2  = d/4)  (1-a)  (1+b) 

h3  = (1/4)  (1-a)  (1-b) 

h4  = (1/4)  (1+a)  (1-b) 

in  quadrilateral  natural  face  coordinates  (a,b). 

(2)  If  any  of  the  entries  P2,P3,P4  are  omitted,  these  values 
are  re-set  to  the  value  of  Pi;  i.e.,  for  a uniformly  dis- 
tributed pressure  (p) , we  have  Pl.EQ.p  and  cc  11-40  blank. 
If  P2  is  zero  specify  a small  number. 
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c . 

Hydrostatic 

Pressure  Data  (7F10.0)  (LT.EO  2.  nnlvl 

notes 

columns 

variable 

entry 

a) 

1 - 

10 

GAMMA 

Weight  density  of  the 
GT.O 

fluid,  y; 

(2) 

11  - 

20 

XS 

X-ordinate  of  point  s 
of  the  fluid 

in  the  free  surface 

21  - 

30 

YS 

Y-ordinate  of  point  s 
of  the  fluid 

in  the  free  surface 

31  - 

40 

ZS 

Z-ordinate  of  point  s 
of  the  fluid 

in  the  free  surface 

41  - 

50 

XN 

X-ordinate  of  a point 
to  the  fluid  surface 

n on  the  normal 

51  - 

60 

YN 

Y-ordinate  of  a point 
to  the  fluid  surface 

n on  the  normal 

61  - 

70 

ZN 

Z-ordinate  of  a point 
to  the  fluid  surface 

n on  the  normal 

NOTES/ 

(1)  GAMMA  is  the  weight  density  (i.e.,  units  of  force  per  unit 
of  fluid  volume)  of  the  fluid  in  contact  with  element  face 
number  NFACE . 


(2) 


Point  s is^any  point  in  the  free  surface  of  the  fluid, 
and  point  n is  located  such  that  the  direction  from  s to 
n is  normal  to  the  free  surface  and  is  positive  with  increas 
depth. 


ing 
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ELEMENT  DATA  (continued) 


Hydrostatic  pressure  in  contact  with  an  element  face  causes 
element  compression;  i.e.,  pressure  resultant  acts  toward  the 
element  centroid.  Nodes  located  above  the  fluid  surface  are 
automatically  assigned  zero  pressure  intensities  if  an  element 
face  is  not  (or  only  partially)  submerged  in  the  fluid. 

5.  Stress  Output  Request  Location  Sets  (715) 


If  NOPSET  is  zero  on  the  Control  Card,  skip  this  section, 
and  global  stresses  will  be  computed  and  output  at  the  element  centroid 
only.  Otherwise,  NOPSET  cards  must  be  input  as  follows: 


notes  column  variable 


entry 


(1) 


1 

6 

11 

16 

21 

26 

31 


5 

10 

15 

20 

25 

30 

35 


LOCI 

L0C2 

L0C3 

L0C4 

L0C5 

L0C6 

L0C7 


NOTES/ 

(1) 


Location  number  of  output  point  1 
Location  number  of  output  point  2 
Location  number  of  output  point  3 
Location  number  of  output  point  4 
Location  number  of  output  point  5 
Location  number  of  output  point  6 
Location  number  of  output  point  7 
LE.  27 


27  element  locations  are  assigned  numbers  as  shown  in  the 
Figure  below.  Locations  1 to  21  correspond  to  node  numbers 
1 to  21,  respectively.  Locations  22  to  27  are  element  face 
centroids.  The  first  zero  (or  blank)  entry  on  a location 
card  terminates  reading  of  location  numbers  for  the  output 
set;  hence,  fewer  than  seven  locations  can  be  requested  in 
an  output  set.  Location  numbers  must  be  input  in  order  of 
increasing  magnitude;  i.e.,  L0C2  is  greater  than  LOCI,  LOC3 
is  greater  than  L0C2 , etc.  In  dynamic  analysis,  FACE  1, 

FACE  2,...,  FACE  6 correspond  to  output  locations  22 ,23,..., 
respectively.  (See  Table  VII. 1). 


27 


6.  Element  Load  Case  Multipliers 


Five  (5)  cards  must  be  input  in  this  section  specifying  the 
fraction  of  gravity  (X,Y,Z),  the  fraction  of  thermal  loads  and  the 
fraction  of  pressure  loads  to  be  added  to  each  of  the  element  loading 
combinations  (A,B,...).  Load  case  multiplier  data  affect  static 
analysis  calculations  only. 


Card  1 X-direction  gravity  (4F10.0) 


notes 

columns 

variable 

entry 

(1) 

1 - 10 

GXA 

Fraction  of  X-direction 
applied  in  element  load 

gravity 
case  A 

31  - 40 

GXD 

Fraction  of  X-direction 
applied  in  element  load 

gravity 
Case  D 
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IV.  ELEMENT  DATA  (continued) 

Card  2 Y-direction  gravity  (4F10.0) 

Card  3 Z-direction  gravity  (4F10.0) 

Card  4 Thermal  loads  (4F10.0) 


notes 

columns 

variable 

entry 

(2) 

1-10 

TA 

Fraction  of  thermal  loads 
in  element  load  case  A 

to  be 

applied 

31  - 40 

TD 

Fraction  of  thermal  loads 
in  element  load  case  D 

to  be 

applied 

Ca  rd  5 

Pressure 

loads  (4F10.0) 

notes 

columns 

variable 

entry 

(3) 

1 - 10 

PA 

Fraction  of  pressure 
in  element  load  case 

loads 

A 

to  be 

applied 

31  - 40 

PD 

Fraction  of  pressure 
in  element  load  case 

loads 

D 

to  be 

applied 

NOTES/ 

(1)  Gravity  loads  on  the  structure  due  to  static  body  forces 
are  computed  from  the  weight  density  of  element  materials 
and  the  element  geometry.  These  loads  are  assigned  to  the 
element  load  combinations  by  means  of  the  entries  on 
Cards  1,2  and  3 for  forces  in  the  X,Y,Z  directions, 
respect ively . 

(2)  Thermal  loads  are  computed  knowing  the  node  temperatures 
input  in  Section  III,  the  stress  free  reference  temperature 
(T  ) input  in  Section  7 and  the  element’s  material  properties 
and  node  coordinates.  The  temperature  distribution  within 
the  element  is  described  using  the  same  interpolation  func- 
tions which  describe  the  variation  of  displacements  within 
the  element . 

(3)  Pressure  loads  are  first  assigned  to  element  load  cases 

(A , B , . . . ) by  means  of  the  entries  (scale  factors)  on  Card  5, 
and  the  distributed  load  sets  which  were  input  in  Section  4 
are  then  applied  to  the  elements  individually  for  cases 
(A , B . . . . ) by  means  of  load  set  references  given  in  Section  7. 


7.  Element  Cards 

Two  cards  (if  MAXN0D.EQ.8)  or  three  cards  (if  MAXN0D.GT.8) 
must  be  prepared  for  each  element  that  appears  in  the  input,  and  the 
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IV.  ELEMENT  DATA  (continued) 
format  for  these  cards  is  as  follows: 


Card  1 

(615 

,F10. 

,415,412) 

notes 

columns 

variable 

entry 

(1) 

1 - 

5 

M 

Element  number; 
GE.l  and  LE.NS0L21 

(2) 

6 - 

10 

NDIS 

Number  of  nodes  to  be  used  in  describing 
the  elements  displacement  field; 

EQ.0;  default  set  to  "mAXNOD" 

(3) 

11  - 

15 

NXYZ 

Number  of  nodes  to  be  used  in  the  description 
of  element  geometry; 

EQ.0;  default  set  to  "NDIS" 

EQ.NDIS  isoparametric  element 

LT.NDIS  -♦  subparametric  element 

16  - 

20 

NMAT 

Material  identification  number; 
GE.l  and  LE . NUMMAT 

(4) 

21  - 

35 

MAXES 

Identification  number  of  the  material 
axis  orientation  set; 

GE.l  and  LE.NORTHO 

EQ.0;  material  axes  default  to  the 
global  X,Y,Z  system 

(5) 

26  - 

30 

I OP 

Identification  number  of  the  stress  output 
location  set; 

GE.l  and  LE.NOPSET 

EQ.0;  centroid  output  only 

(6) 

31  - 

40 

TZ 

Stress  free  reference  temperature,  T 

41  - 

45 

KG 

Node  number  increment  for  element  data 
generation ; 

EQ.0;  default  set  to  "l" 

46  - 

50 

NRSINT 

Integration  order  for  natural  coordinate 
(r,s)  directions; 

EQ.0;  default  set  to  "iNTRS" 

51  - 

55 

NTINT 

Integration  order  for  natural  coordinate 
(t)  direction; 

EQ.0;  default  set  to  "iNTT" 

(7) 

56  - 

60 

I RE  USE 

Flag  indicating  that  the  stiffness  and 
mass  matrices  for  this  element  are  the 
same  as  those  for  the  preceding  element ; 
EQ.0;  no 
EQ.l;  yes 

(8) 

61  - 

62 

LSA 

Pressure  set  for  element  load  case  A 

63  - 

64 

LSB 

Pressure  set  for  element  load  case  B 

65  - 

66 

LSC 

Pressure  set  for  element  load  case  C 

67  - 

68 

LSD 

Pressure  set  for  element  load  case  D; 

LE.NDLS 
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Card  2 (1615) 


notes 

columns  variable 

ent  ry 

(9) 

1-5 

Node 

1 

number 

6-10 

Node 

2 

number 

11  - 15 

Node 

3 

number 

16  - 20 

Node 

4 

number 

21  - 25 

Node 

5 

number 

26  - 30 

Node 

6 

number 

31  - 35 

Node 

7 

number 

36  - 40 

Node 

8 

number 

(10) 

41  - 45 

Node 

9 

number 

46  - 50 

Node 

10 

number 

51  - 55 

Node 

11 

number 

56  - 60 

Node 

12 

number 

61  - 65 

Node 

13 

number 

66  - 70 

Node 

14 

number 

71  - 75 

Node 

15 

number 

76  - 80 

Node 

16 

number 

Card  3 

(515)  (required  if 

MAXNOD. GT. 8) 

note 

columns  variable 

entry 

1-5 

Node 

17 

number 

6-10 

Node 

18 

number 

11  - 15 

Node 

19 

number 

16  - 20 

Node 

20 

number 

21  - 25 

Node 

21 

number 

NOTES/ 

(1)  Element  cards  must  be  input  in  ascending  element ^number 
order  beginning  with  "l"  and  ending  with  NSOL21  . Repetition 
of  element  numbers  is  illegal,  but  element  cards  may  be 
omitted,  and  missing  element  data  are  generated  according 

to  the  procedure  described  in  note  (7) . 

(2)  NDIS  is  a count  of  the  node  numbers  actually  posted  on 
Cards  2 and  3 which  must  immediately  follow  Card  1. 

NDIS  must  be  at  least  eight  (8) , but  must  be  less  than 
or  equal  to  the  limit  (MAXNOD)  which  was  given  on  the 
Control  Card,  Section  1.  Element  displacements  are 
assigned  at  the  NDIS  non-zero  nodes,  and  thus,  the 
order  of  the  element  matrices  is  three  (i.e. , trans- 
lations X , Y, Z)  times  NDIS.  The  eight  corner  nodes  of 
the  hexahedron  must  be  input,  but  nodes  9 to  21  are 
optional,  and  any  or  all  of  these  optional  nodes  may 
be  used  to  describe  the  element's  displacement  field. 
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(3)  When  element  edges  are  straight  it  is  unnecessary 
computationally  to  include  side  nodes  in  the  numerical 
evaluation  of  coordinate  derivatives,  the  Jacobian 
matrix,  etc.,  and  since  regular  element  shapes  are 
common,  an  option  has  been  included  to  use  fewer  nodes 
in  these  geometric  calculations  than  are  used  to 
describe  element  displacements.  The  first  NXYZ  non- 
zero nodes  posted  on  Cards  2 and  3 are  used  to  evaluate 
those  parameters  which  pertain  to  element  geometry 
only.  NXYZ  must  be  at  least  eight  (8),  and  if  omitted 
is  re-set  to  NDIS.  A common  application  might  be  a 

20  node  element  (i.e.,  NDIS. EQ. 20)  with  straight  edges 
in  which  case  NXYZ  would  be  entered  as  M8". 

(4)  MAXES  (unless  omitted)  refers  to  one  of  the  material 
axes  set  defined  in  Section  3.  If  omitted,  the 
material  (NMAT)  orientation  is  such  that  the  (X^,X2jX^) 
axes  coincide  with  the  (X,Y,Z)  axes,  respectively. 

(5)  I0P  (unless  omitted)  refers  to  one  of  the  output  location 
sets  given  in  Section  5.  If  IOP.EQ.0,  stress  output  is 
quoted  at  the  element  centroid  only.  Stress  output  at 

a point  consists  of  three  normal  and  three  shear 
components  referenced  to  the  global  (X,Y,Z)  axes. 

(6)  When  element  cards  are  omitted,  element  data  are  generated 
automatically  as  follows: 

(a)  all  data  on  Card  1 for  generated  elements 
is  taken  to  be  the  same  as  that  given  on 
the  first  element  card  in  the  sequence; 

(b)  non-zero  node  numbers  (given  on  Cards  2 and 
3 for  the  first  element)  are  incremented  by 
the  value  "kg"  (which  is  given  on  Card  1 of 
the  first  element)  as  element  generation 
progresses  ; zero  (or  blank)  node  number  en- 
tries are  generated  as  zeroes. 

The  last  element  cannot  be  generated. 

(7)  The  flag  IREUSE  allows  the  program  to  bypass  stiffness 
and  mass  matrix  calculations  providing  the  current 
element  is  identical  to  the  preceding  element;  i.e., 
the  preceding  and  current  elements  are  identical  except 
for  a rigid  body  translation.  If  IREUSE. EQ.O,  new 
matrices  are  computed  for  the  current  element. 

If  IREUSE. EQ.l  it  is  also  assumed  that  the  node 
temperatures  of  the  element  (for  calculation  of  thermal 
loads)  are  the  same  as  those  of  the  preceding  element. 
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IV.  ELEMENT  DATA  (continued) 


(8)  Pressure  loads  are  assigned  (i.e.,  applied)  to  the 
element  by  means  of  load  set  references  in  cc  61-62 
for  combination  A,  cc  63—64  for  B,  etc.  A zero  entry 
means  that  no  pressure  acts  on  the  element  for  that 
particular  element  load  combination. 

(9)  The  first  eight  node  numbers  establish  the  corners  or 
vertices  of  a general  hexahedron  and  must  be  all  non- 
zero, (see  Figure  in  Section  1 on  control  cards).  Node 
numbers  must  be  input  in  the  sequence  indicated  otherwise 
volume  and  surface  area  integrations  will  be  indefinite. 

(10)  The  number  of  cards  required  as  input  for  each  element 
depends  on  the  variable  MAX NOD.  For  the  case  of 
MAXN0D.EQ.8,  only  Card  2 is  required.  If  MAXN0D.GT.8, 
Cards  2 and  3 are  required  for  all  elements. 

Nodes  9 to  21  are  optional,  and  only  those  nodes  actually 
used  to  describe  the  element  are  input.  The  program 
will  read  all  21  entries  if  MAXNOD  was  given  as  9 or 
greater,  but  only  NDIS  non-zero  values  are  expected 
to  be  read  on  Cards  2 and  3.  If  for  example  one  element 
is  described  by  10  nodes,  then  cc  1-40  on  Card  2 would  be 
the  eight  corner  node  numbers,  and  the  remaining  two 
node  numbers  would  be  posted  somewhere  on  Cards  2 and  3. 


IV . ELEMENT  DATA  (continued) 


TYPE  9 - 


THREE-DIMENSIONAL  STRAIGHT  OR  CURVED  /PI  PE  ELEMENTS 


Pipe  elements  are  identified  by  the  number  twelve  (12).  Axial 
and  shear  forces,  torque  and  bending  moments  are  calculated  for  each 
member.  Gravity  loadings  in  the  global  (X,Y,Z)  directions,  uniform 
temperature  changes  (computed  from  input  nodal  temperatures) , and 
extensional  effects  due  to  internal  pressure  form  the  basic  member 
loading  conditions.  Pipe  element  input  is  described  by  the  following 
sequence  of  cards: 


1. 

Control  Card 

(1415) 

notes 

columns 

vari able 

en  t ry 

4 - 

5 

Enter  the  number  "12" 

CD 

6 - 

10 

NPIPE 

Number  of  pipe  elements 

11  - 

15 

NUMMAT 

Number  of  material  sets 

16  - 

20 

MAXTP 

Maximum  number  of  temperature  points 
used  in  the  table  for  any  material 
GE . 1 ; at  least  one  point 

21  - 

25 

NSECT 

Number  of  section  property  sets;  GE . 1 

(2) 

26  - 

30 

NBRP 

Number  of  branch  point  nodes  at  which 
output  is  required; 

EQ.O;  no  branch  point  output  is 

produced 

31  - 

35 

MAX TAN 

Maximum  number  of  tangent  elements 
common  to  any  one  branch  point  node; 
EQ.O;  default  set  to  "4" 

36  - 

40 

NPAR(8) 

Blank 

41  - 

45 

NPA  R ( 9) 

Tangent  stiffness  load  matrix  dump  flag 
EQ.l;  Print 

EQ.O;  Suppress  printing 

46  - 

50 

NPAR(10) 

Bend  stiffness  load  matrix  dump  flag 
EQ.l;  Print 

EQ.O;  Suppress  printing 

51  - 

55 

NPAR(ll) 

Element  parameters  dump  flag 

EQ.l;  Print 

EQ.O;  Suppress  printing 

NOTES/ 

(1)  The  number  of  pipe  elements  ("NPIPE")  counts  both  tangent 
and  bend  geometries,  and  both  the  material  and  section 
property  tables  can  reference  either  the  bend  or  tangent 
element  types. 

(2)  A branch  point  is  defined  as  a nodal  location  where  at 
least  three  (3)  tangent  pipe  elements  connect.  The  two 
input  parameters  "NBRP"  and  "MAXTANM  reserve  storage  for 
an  index  array  created  during  the  processing  of  pipe 
element  data;  posting  a larger  number  of  maximum  common 
tangents  than  actually  exist  is  not  considered  a fatal  error 
condition.  Branch  point  data  is  read  if  requested,  but  not 
currently  used;  i.e.  to  be  used  in  future  program  versions. 
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IV.  ELEMENT  DATA  (continued) 


2 . Material  Property  Cards 

Temperature-dependent  Young* s modulus  (E)  , Poisson's  ratio 

(v)  and  thermal  expansion  coefficient  (a)  are  allowed.  If  more  than 

one  (1)  temperature  point  is  input  for  a material  table,  then  the  program 

selects  properties  using  linear  interpolation  between  input  temperature 

values.  The  temperature  used  for  property  selection  is  the  average 

element  temperature  which  is  denoted  as  T : 

a 

T = (T  + T .)  /2 
a i J 

where  Ti  and  Tj  are  the  input  nodal  temperatures  for  ends  "i"  and  "j" 
of  the  pipe.  For  each  different  material,  the  following  set  of  cards 
must  be  input: 


a.  material  identification  card  (215, 6A6) 


notes  columns  variable  entry 


11  - 46 


Material  identification  number; 

GE.l  and  LE.NUMMAT 

Number  of  different  temperatures  at 
which  properties  are  given; 

EQ.O;  one  temperature  point  is 
assumed  to  be  input 
Material  description  used  to  label 
the  output  for  this  material 


(1)  Material  identification  number  must  be  input  between  one  ("l") 
and  the  total  number  of  materials  specified  (mNUMMATm) 


b,  material  cards  (4F10.0) 


notes  columns  variable  entry 

(1)  1-10  T(N)  Temperature,  Tn 

11  - 20  E(N)  Young's  modulus,  En 

21  - 30  XNU(N)  Poisson's  ratio, 

31  - 40  ALP(N)  Thermal  expansion  coefficient, 

NOTES/ 

(1)  Supply  one  card  for  each  temperature  point  in  the  material 
table;  at  least  one  card  is  required.  Temperatures  must 
be  input  in  increasing  (algebraic)  order.  If  two  or  more 
points  are  used,  care  must  be  taken  to  insure  that  the  table 
covers  the  expected  range  of  average  temperatures  existing 
in  the  elements  to  which  the  material  table  is  assigned. 
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IV,  ELEMENT  DATA  (continued) 


3.  Section  Property  Cards  ( 15 , 5F10 . 0 , 3A6) 


notes 

columns 

variable 

en  t ry 

(i) 

1 - 

5 

N 

Section  property  identification  number 

GE.l  and  LE.NSECT 

(2) 

6 - 

15 

Outside  diameter  of  the  pipe,  dQ 

16  - 

25 

Pipe  wall  thickness,  t 

26  - 

35 

Shape  factor  for  shear  distortion, 

(3) 

36  - 

45 

Weight  per  unit  length  of  section, 

Vi 

(4) 

46  - 

55 

Mass  per  unit  length  of  section, 

56  - 

73 

Section  description  (used  to  label 

t he 

output ) 

NOTES  / 

(1)  Section 

property  identification  numbers  must  be  input  in 

an 

ascending  sequence  beginning  with  one  ("l")  and  ending  with 
the  total  number  of  section  specified  (MNSECTM) • 


(2)  Assuming  that  (y,z)  are  the  section  axes  and  that  the  x-axis 
is  normal  to  the  section,  the  properties  for  the  section  are 
computed  from  the  input  parameters  [dQl  t and  o^]  as  follows 

(a)  inner  and  outer  pipe  radii; 

r = d /2 

0 o 

r . = r - t 

1 o 

(b)  cross  sectional  area  (axial  deformations); 


(c)  principal  moments  of  inertia  (bending)  ; 
Iy  = ( tt/4  ) (r^  - r^) 


(d) 


(e) 


I = I 
z y 

polar  moment  of 

J =21 
x y 

effective  shear 

A = A /<* 
y xv 

A = A 
z y 


inertia  (torsion) ; 


areas  (shear  distortions)  ; 


Note  that  the  shape  factor  for  shear  distortion  (a  ) may 
be  input  directly.  If  the  entry  is  omitted,  the  shape 
factor  is  computed  using  the  equation: 

a = (4  3)  (r3  - r3)/[(r2  + r2)  (r  - r.)] 

V o 1 O 1 o 1 

-2.0 


IV. 9.3 
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IV.  ELEMENT  DATA  (continued) 


An  input  value  for  c*v  greater  than  one  hundred  (100.) 
causes  the  program  to  neglect  shear  distortions  entirely. 
If  used,  the  same  shape  factor  is  applied  to  both  in  and 
out-of-plane  shear  distortions. 

(3)  The  weight  per  unit  length  of  section  (Yj)  is  used  to 
compute  gravity  loadings  on  the  elements.  Fixed  end 
shears,  moments,  torques,  etc.  are  computed  automatically 
and  applied  as  equivalent  nodal  loads.  These  forces  will 
not  act  on  the  structure  unless  first  assigned  to  one  of 
the  element  load  cases  (A.B.C.D)  in  Section  IV. L. 5,  below. 

(4)  The  mass  per  unit  length  is  only  used  to  form  the  lumped 
mass  matrix  for  a dynamic  analysis  case.  If  no  entry  is 
input,  then  the  program  will  re-define  the  mass  density 
from  the  weight  density  using: 

01  = Y1/386.4 

Either  a non-zero  weight  density  or  mass  density  will 
cause  the  program  to  assign  masses  to  all  pipe  element 
nodes . 

4 . Branch  Point  Node  Numbers 

If  the  number  of  output  branch  point  nodes  has  been 
omitted  from  the  control  card  (i.e.,  cc  26-30  blank),  skip  this  section 
of  input,  and  no  branch  point  data  will  be  read.  Otherwise,  supply 
node  numbers  for  a total  number  of  branch  points  requested  on  the 
control  card,  ten  (10)  nodes  per  card: 


f i r s t c a rd 

notes  columns 

(1)  1-5 

6-10 

45-50 

second  card 

notes  columns 

1-5 


(1015) 

variable  entry 

Node  number  at  branch  point  1 
Node  number  at  branch  point  2 

Node  number  at  branch  point  10 

(1015)  --  if  required 

variable  entry 

Node  number  at  branch  point  11 


NOTES. 

(1)  A node  does  not  define  a branch  point  unless  at  least  three  (3) 
tangent  elements  are  common  to  the  node.  Branch  point  output 
is  only  produced  for  static  analysis  cases. 


IV. 9. 4 


IV.  ELEMENT  DATA  (continued) 

5 . Element  Load  Case  Multipliers 


Five  (5)  cards  must  be  input  in  this  section  specifying 
the  fraction  of  gravity  (in  each  of  the  X,Y,Z  coordinate  directions), 
the  fraction  of  thermal  loading  and  the  fraction  of  internal  pipe 
pressure  loading  to  be  added  to  each  of  four  (4)  possible  element 
loading  combinations  (A,B,C,D). 


Card  1 

X-direct ion 

gravity 

(4F10.0) 

notes 

columns 

variable 

ent  ry 

(1) 

1-10 

Fraction  of  X-direction  gravity  to  be 
applied  in  element  load  case  A 

11  - 20 

Fraction  of  X-direction  gravity  to  be 
applied  in  element  load  case  B 

21  - 30 

Fraction  of  X-direction  gravity  to  be 
applied  in  element  load  case  C 

31  - 40 

Fraction  of  X-direction  gravity  to  be 
applied  in  element  load  case  D 

Card  2 

Y-d i rec  t ion 

gravity 

(4F10.0) 

Card  3 

Z-d irec t ion 

gravity 

(4F10.0) 

Card  4 

Thermal  loads 

(4F10.0) 

notes 

columns 

variable 

entry 

(2) 

1-10 

Fraction  of  thermal  loading  to  be 
applied  in  element  load  case  A 

11  - 20 

Fraction  of  thermal  loading  to  be 
applied  in  element  load  case  B 

21  - 30 

Fraction  of  thermal  loading  to  be 
applied  in  element  load  case  C 

31  - 40 

Fraction  of  thermal  loading  to  be 
applied  in  element  load  case  D 

Card  5 

Internal  pressure 

(4F10.0) 

notes 

columns 

variable 

ent  ry 

(3) 

1-10 

Fraction  of  pressure -induced  loading 
applied  in  element  load  case  A 

11  - 20 

Fraction  of  pressure -ind uced  loading 
applied  in  element  load  case  B 

21  - 30 

Fraction  of  pressure -induced  loading 
applied  in  element  load  case  C 

31  - 40 

Fraction  of  pressure -induced  loading 

applied  in  element  load  case  D 


IV.  9..  5 


NON- VERTICAL  TANGENT 
IN  LOCAL  AXES 


if— * 

'PARALLEL  TO  GLOBAL  Z-AXIS 


VERTICAL  TANGENT 


LOCAL  COORDINATE  SYSTEMS  FOR 
PIPE  ELEMENTS 
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IV.  ELEMENT  DATA  (continued) 


5.  Element  Load  Case  Multipliers  (continued) 

NOTES 


(1)  No  gravity  loads  will  be  produced  if  the  weight  per 
unit  length  was  input  as  zero  on  all  section  property 
cards.  Otherwise,  a multiplier  of  1.0  input  for  an 
element  load  case  means  that  100%  of  deadweight  will 
be  assigned  to  that  load  combination. 

(2)  No  thermal  loading  will  result  if  the  coefficient  of 
thermal  expansion  has  been  omitted  from  all  the  material 
cards.  Otherwise,  thermal  loads  are  computed  for  each 
element  using  the  AT  between  the  average  element  tempera- 
ture (Ta)  and  the  stress-free  temperature  (TQ)  given 
with  each  pipe  element  card  (Section  IV.L.6,  below). 

(3)  Element  distortions  are  computed  for  each  element  due 
to  internal  pressure,  and  these  loads  are  combined  into 
element  load  cases  by  means  of  appropriate  non-zero 
entries  in  Card  5. 

Gravity,  thermal  or  pressure  induced  loads  cannot  act 
on  the  structure  unless  first  combined  in  one  or  more 
of  the  element  load  sets  (A,B,C,D).  Once  defined, 
element  load  cases  are  assigned  (via  scale  factors) 
to  the  structure  load  cases  by  means  of  Element  Load 
Multipliers  given  in  Section  VI.  An  element  load 
case  combination  may  be  used  a multiple  number  of 
times  when  defining  the  various  structure  loading 
eond i t ions . 


6.  Pipe  Element  Cards 


a.  card  type  1 


notes  columns  variable  entry 


(1)  1-4  N 

5 


6 - 

10 

I 

11  - 

15 

J 

16  - 

20 

MAT 

21  - 

25 

ISECT 

(2) 

26  - 

35 

(3) 

36  - 

45 

(1) 

46  - 

55 

Pipe  element  number; 

GE.l  and  LE.NPIPE 
Geometric  type  code : 

"t"  (or  blank);  tangent  section 

it  i» 

B ; bend  (circular)  section 

Node  I number 
Node  J number 

Material  identification  number; 

GE.l  and  LE.NUMMAT 

Section  property  identification  number; 

GE.l  and  LE.NSECT 

Stress- free  temperature,  TQ 

Internal  pressure,  p 

Positive  projection  of  a local  y- 

vector  on  the  global  X-axis;  A(yX) 
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IV.  ELEMENT  DATA  (continued) 


! 


6.  Pipe  Element  Cards  (continued) 
notes  columns  variable  entry 

Positive  projection  of  a local  y- 
vector  on  the  global  Y-axis;  A (y Y) 
Positive  projection  of  a local  y- 
vector  on  the  global  Z-axis  A (yZ) 

Node  number  increment  for  tangent 
element  generation  ; 

EQ.O;  default  set  to  "l" 

NOTES/ 

(1)  Card  type  1 is  used  for  both  tangent  and  bend  elements; 

a second  card  (card  type  2,  below)  must  be  input  immedi- 
ately following  card  type  1 if  the  pipe  element  is  a 
bend  (i.e.,  B in  cc  5).  Note  that  element  cards  must 
be  input  in  ascending  sequence  beginning  with  one  ("l”) 
and  ending  with  the  total  number  of  pipe  elements. 

If  tangent  elements  are  omitted,  generation  of  the 
intermediate  elements  will  occur;  the  generation  algorithm 
is  described  below.  An  attempt  to  generate  bend  type 
elements  is  considered  to  be  an  error. 

(2)  The  stress-free  temperature,  TQ , is  subtracted  from 
the  average  element  temperature,  Ta , to  compute  the 
uniform  temperature  difference  acting  on  the  element: 

AT  = T - T 
a o 

The  entire  element  is  assumed  to  be  at  this  uniform 
value  of  temperature  difference. 

(3)  The  value  of  pressure  is  used  to  compute  a set  of 
self-equilibrating  joint  forces  arising  from  member 
distortions  due  to  pressurization;  i.e.,  the  mechanical 
equivalent  of  thermal  loads.  For  bend  elements,  the  pressure 
is  also  used  to  compute  the  bend  flexibility  factor,  kp.  The 
curved  pipe  subjected  to  bending  is  more  flexible  than  ele- 
mentary beam  theory  would  predict.  The  ratio  of  "actual 
flexibility  to  that  predicted  by  beam  theory  is  denoted  by  kp , 
where 

kp  = (1 . 65/h) /[ 1 + (6p/Eh) (R/t)4/3l  a 1 
in  which 

. 2 

h = tR/r 
r = (d  - t)/2 


56  - 65 
66  - 75 

(5)  76  - 80  KG 
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IV.  ELEMENT  DATA  (continued) 


6.  Pipe  Element  Cards  (continued) 


and 


t = pipe  wall  thickness 
R = radius  of  the  circular  bend 
r = mean  radius  of  the  pipe  cross  section 
dQ  = outside  diameter  of  the  pipe 
E = Young's  modulus 
p = internal  pressure 

The  flexibility  factor  is  computed  and  applied  to  all 
bend  elements;  pressure  stiffening  is  neglected  if  the 
entry  for  internal  pressure  ("p")  is  omitted. 

(4)  The  global  projections  of  the  local  y-axis  for  a tangent 
member  may  be  omitted  (cc  46-75  blank);  for  this  case, 
the  following  convention  for  the  local  system  is  assumed 

(a)  tangents  parallel  to  the  global  Y-axis 
(vertical  axis)  have  their  local  y-axes 

directed  parallel  to  and  in  the  same  direc- 
tion as  the  global  Z-axis ; 

(b)  tangents  not  parallel  to  the  global  Y-axis 
have  their  local  y-axes  contained  in  a vertical 
(global)  plane  such  that  local  y projects 
positively  on  the  positive  global  Y-axis. 

For  bend  elements,  the  global  projections  of  the  local 
y-axis  are  not  used;  instead,  the  local  axis  convention 
is  defined  as  follows: 

(a)  the  local  y-axis  is'  directed  positively  toward 
and  intersects  the  center  of  curvature  of  the 
bend  (i.e.,  radius  vector); 

(b)  the  local  x-axis  is  tangent  to  the  arc  of  the 
bend  and  is  directed  positively  from  node  I 
to  node  J. 

Note,  that  for  all  elements,  the  local  x,  y,  z system 
is  a right-handed  set  (see  figure)  . 

(5)  If  a tangent  element  sequence  exists  such  that  each 
element  number  (NE^)  is  one  (1)  greater  than  the  pre- 
vious number  (NEi_1) ; i.e., 

NE.  = NE.  . +1 

l l-l 

only  the  element  card  for  the  first  tangent  in  the 
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IV.  ELEMENT  DATA  (continued) 


6.  Pipe  Element  Cards  (continued) 

series  need  be  input.  The  node  numbers  for  the  missing 
tangents  are  computed  using  the  formulae: 

NI  = NI . + KG 

i l-l 


NJ.  = NJ.  , + KG 
1 l-l 


where  "kg"  is  the  node  number  increment  input  in 
cc  76-80  for  the  first  element  in  the  series,  and 
the 


(a)  material  identification  number 

(b)  section  property  identification  number 

(c)  stress-free  temperature 

(d)  internal  pressure 

(e)  y-axis  global  projections 

for  each  tangent  in  the  generation  sequence  are  taken  to 
be  the  same  as  those  input  on  the  first  card  in  the 
series.  The  node  number  increment  ("kg")  is  reset  to  one 
(1)  if  left  blank  on  the  first  card  in  the  series.  The 
last  (highest)  element  cannot  be  generated;  i.e.,  it  must 
be  input. 

Bend  element  data  cannot  be  generated  because  two  input 
cards  are  required  for  each  bend.  Also,  the  element 
just  prior  to  a bend  element  must  appear  on  an  input 
card.  Several  bends  may  be  input  in  a sequence,  but 
each  bend  must  appear  (on  two  cards)  in  the  input  stream. 


b. 

card 

type  2 (FlO . 

0 ,3X,A2,4F10.0) 

notes 

columns 

variable 

entry 

(1) 

1 - 

10 

R 

Radius  of  the  bend  element,  R 

(2) 

14  - 

15 

Third  point  type  code: 

"Tl"  (or  blank) ; third  point  is  the 

tangent  intersection  point 

"CC"  ; third  point  is  the 

center  of  curvature 

16  - 

25 

X-ordinate  of  the  third  point, 

26  - 

35 

Y-ordinatc  of  the  third  point,  Y3 

36  - 

45 

Z-ordinate  of  the  third  point,  Z3 

46  - 

55 

Fraction  of  wall  thickness  to  be 

used  for  dimensional  tolerance  tests 
EQ.O;  default  set  to  "O.l" 


FORCE  SIGN  CONVENTION  FOR  PIPE 
ELEMENT  OUTPUT 


IV. 9. 11 


IV.  ELEMENT  DATA  (continued) 


6.  Pipe  Element  Cards  (continued) 

NOTES/ 

(1)  The  radius  of  the  bend  ("r")  must  be  input  regardless 
of  the  method  ("Tl"  or  MCCU)  used  to  define  the  third 
point  for  the  bend . 

(2)  If  the  tangent  intersection  point  is  used , the  program 
computes  a radius  for  the  bend  and  compares  the  compu- 
ted value  with  the  input  radius.  An  error  condition 
is  declared  if  the  two  radii  are  different  by  more 
than  the  specified  fraction  (or  multiple)  of  the 
section  wall  thickness.  The  lengths  of  the  two 
tangent  lines  (I  to  TI  and  J to  TI)  are  compared  for 
equality,  and  an  error  will  be  flagged  if  the  two 
values  are  discrepant  by  more  than  the  dimensional 
tolerance . 

If  the  center  of  curvature  is  input,  the  distances 
from  the  third  point  to  nodes  I and  J are  compared 
to  the  input  radius;  discrepancies  larger  than  the 
user  defined  tolerance  are  noted  as  errors. 

This  second  element  card  is  only  to  be  input  for  the 
bend  type  element. 

Element  Stress  Output 


Stress  output  for  pipe  elements  consists  of  forces  and  moments 
acting  in  the  member  cross  sections  at  the  ends  of  each  member  and 
at  the  midpoints  of  the  arcs  in  bend  elements.  Output  quantitites 
act  on  the  element  segment  connecting  the  particular  output  station 
and  end  i;  i.e.,  j to  i,  center  to  i,  or  AX  to  i (where  AX  *4  0)  . 
Positive  force/moment  vectors  are  directed  into  the  positive  local 
(x,y,z)  directions,  as  shown  in  the  accompanying  figure. 


V.  CONCENTRATED  LOAD/MASS  DATA  (2l5,6Fl0.4) 


notes 

columns 

variable 

entry 

(i) 

1 - 

5 

N 

Nodal  point  number 

(2) 

6 - 

10 

L 

Structure  load  case  number; 
GE.l;  static  analysis 

EQ.0;  dynamic  analysis 

11  - 

20 

FX(N,L) 

X-direction  force 
mass  coefficient) 

(or  translational 

21  - 

30 

FY  (N , L) 

Y-direction  force 
mass  coefficient) 

(or  translational 

31  - 

40 

FZ  (N , L) 

Z-direction  force 
mass  coefficient) 

(or  translational 

41  - 

50 

MX (N,L) 

X-axis  moment  (or 

rotational  inert i a) 

51  - 

60 

MY  (N,  L) 

Y-axis  moment  (or 

rotational  inert i a) 

61  - 

70 

MZ(N,L) 

Z-axis  moment  (or 

rotational  inertia) 

NOTES/ 

(1)  For  a static  analysis  case  (NDYN.EQ.O) , one  card  is  required 

for  each  nodal  point  ("n")  having  applied  (non-zero)  concentrated 
forces  or  moments.  All  structure  load  cases  must  be 
grouped  together  for  the  node  ("n")  before  data  is  entered 
for  the  next  (higher)  node  at  which  loads  are  applied.  Only 
1 - - n l c the  structure  load  cases  for  which  node  N is  loaded  need  be 

r,  given,  but  the  structure  load  case  numbers  ("l")  which  are 
' ' *•  referenced  must  be  supplied  in  ascending  order.  Node  loadings 

l must  be  defined  (input)  in  increasing  node  number  order,  but 
again,  only  those  nodes  actually  loaded  are  required  as  input. 

The  static  loads  defined  in  this  section  act  on  the  structure 
exactly  as  input  and  are  not  scaled,  factored,  etc.  by  the 
element  load  case  (A,B,C,D)  multipliers  (Section  VI,  below). 

Nodal  forces  arising  from  element  loadings  are  combined 
(additively)  with  any  concentrated  loads  given  in  this 
section.  Applied  force/moment  vectors  act  on  the  structure, 
positive  in  the  positive  global  directions.  Only  one  card 
is  allowed  per  node  per  load  case. 

For  a dynamic  analysis  case  (NDYN. EQ. 1 ,2,  3 or  4) , structure 
load  cases  have  no  meaning,  but  the  program  expects  to  read 
data  in  this  section  nonetheless.  In  place  of  concentrated 
loads,  lumped  mass  coefficients  for  the  nodal  degrees  of 
freedom  may  be  input  for  any  (or  all)  nodes.  The  mass  matrix 
is  automatically  constructed  by  the  program  from  element 
geometry  and  associated  material  densities;  the  mass  coefficients 
read  in  this  section  are  combined  (additively)  with  the  exist- 
ing element-based  lumped  mass  matrix.  For  mass  input,  a node 
may  only  be  specified  once,  and  the  load  case  number  ( L ) 
must  be  zero  (or  blank). 


V.l 


V. 


CONCENTRATED  LGAD/MASS  DATA  (2I5,6Fl0.4)  (continued) 


The  program  terminates  reading  loads  (or  mass)  data  when 
a zero  (or  blank)  node  number  ("n")  is  encountered;  i.e., 
terminate  this  section  of  input  with  a blank  card. 

For  the  special  case  of "a"  static  analysis  with  no 
concentrated  loads  applied,  input  only  one  (1)  blank 
card  in  this  section.  Similarly,  a dynamic  analysis 
in  which  the  mass  matrix  is  not  to  be  augmented  by  any 
entries  in  this  section  requires  only  one  (1)  blank 
card  as  input. 

(2)  For  a static  analysis,  structure  load  case  numbers 
range  from  "l"  to  the  total  number  of  load  cases 
requested  on  the  Master  Control  Card  ("ll") ; thus, 

1 ^ L £ LL,  NDYN.EQ.O.  For  a dynamic  analysis,  only  zero 
(0)  references  are  allowed;  thus,  L = 0,  NDYN.EQ.1,2 
3 , or  4 . 


VI  . 

ELEMENT 

LOAD 

MULTIPLIERS 

(4F10.0)  — , 

i y\  r i 

A 

-id 

notes 

col  umns 

variable 

entry 

(1,2) 

1 - 

10 

EM  ( 1 ) 

Mul t iplier 

for 

element 

load 

case 

A 

11  - 

20 

EM  (2) 

Multiplier 

for 

element 

load 

case 

B 

21  - 

30 

EM  (3) 

Mul t iplier 

for 

element 

load 

case 

C 

31  - 

40 

EM  (4) 

Mult iplier 

for 

element 

load 

case 

D 

NOTES/' 

(1)  One  card  must  be  given  for  each  static  (NDYN.EQ.O)  structure 
load  case  requested  on  the  Master  Control  Card  ("ll") . The 
cards  must  reference  load  case  numbers  in  ascending  order. 

The  four  (4)  element  load  sets  (A,B,C,D),if  created  during 
the  processing  of  element  data  (Section  IV,  above),  are 
combined  with  any  concentrated  loads  specified  in  Section  V 
for  the  structure  load  cases.  For  example,  suppose  an  analysis 
case  calls  for  seven  (7)  static  structure  loading  conditions 
(i.e.,  LL  =7),  then  the  program  expects  to  read  seven  (7) 
cards  in  this  section.  Further,  suppose  card  number  three  (3) 
in  this  section  contains  the  entries: 

t EM  ( 1 ) , EM  (2 ) , EM  (3  ) , EM  (4  ) ] = [-3 .0  f 0 .0 ,2 .0 ,0 . 0] 

Structure  load  case  three  (3)  will  then  be  constructed 
using  100%  of  any  concentrated  loads  specified  in 
Section  V minus  (-)  300%  of  the  loads  in  element  set  A plus 
(+)  200%  of  the  loads  in  element  set  C.  Load  sets  B and  D 
will  not  be  applied  in  structure  load  case  3.  Element  load 
sets  may  be  referenced  any  number  of  times  in  order  to 
construct  different  structure  loading  conditions.  Element- 
based  loads  (gravity,  thermal,  etc.)  can  only  be  applied  to 
the  structure  by  means  of  the  data  entries  in  this  section. 

(2)  If  this  case  calls  for  one  of  the  dynamic  analysis  options, 
supply  only  one  blank  card  in  this  section.  If  the  job  is 

a dynamic  re-start  case  (NDYN.EQ.-2  or  -3),  skip  this  section. 

Static  analysis  input  is  complete  with  this  section.  Begin 
a new  data  case  with  a new  Heading  Card  (see  Section  I). 


VII.  DYNAMIC  ANALYSES 


1 


Four  (4)  types  of  dynamic  analysis  can  be  performed  by  the  program. 
The  type  of  analysis  is  indicated  by  the  number  MNDYN"  specified  in  card 
columns  21-25  of  the  Master  Control  Card  (Section  II).  If 

NDYN.EQ.l;  Determination  of  system  mode  shapes  and 
frequencies  only 

(complete  input  Section  VII. A,  only) 

NDYN.EQ.2;  Dynamic  Response  Analysis  for  arbitrary 

time  dependent  loads  using  mode  superposition 
(complete  both  Sections  VII. A and  B below) 

NDYN.EQ.3;  Response  Spectrum  Analysis 

(complete  both  Sections  VII. A and  C,  below) 

NDYN.EQ.4;  Dynamic  Response  Analysis  for  arbitrary  time 
dependent  loads  using  step-by-step  direct 
int  egrat ion 

(complete  Section  VII. B below) 

In  any  given  dynamic  analysis  case  only  one  (1)  value  of  NDYN  will  be 
considered.  However,  if  NDYN.EQ.2  or  3,  the  program  must  first  solve 
the  eigenvalue  problem  for  structure  modes  and  frequencies.  These 
eigenvalues/vectors  are  then  used  as  input  to  either  the  Forced  Response 
Analysis  (NDYN.EQ.2)  or  to  the  Response  Spectrum  Analysis  (NDYN.EQ.3). 
Hence,  options  1,  2 or  3 all  require  that  the  control  parameters  for 
eigenvalue  extraction  be  supplied  in  Section  VII. A,  below. 

In  case  of  a direct  step-by-step  integration  analysis  (NDYN.EQ.4) 
do  not  provide  the  eigenvalue  solution  control  card  of  Section  VII. A. 

For  the  special  case  of  dynamic  analysis  re-start  (NDYN.EQ.-2  or  -3), 
data  input  consists  of  the  Heading  Card  (Section  I),  the  Master  Control 
Card  (Section  II),  and  either  of  Sections  VII. B (-2)  or  VII, C (-3), 
below.  Re-starting  is  possible  only  if  a previous  solution  using  the 
same  model  was  performed  with  NDYN.EQ.l,  and  the  results  from  this 
eigenvalue  solution  were  saved  on  the  re-start  file.  (See  Appendix  A.) 

Up  to  this  section  the  program  processes  (i.e.,  expects  to  read) 
essentially  the  same  blocks  of  data  for  either  the  static  or  dynamic 
analysis  cases;  certain  of  these  preceding  data  cards,  however,  are 
read  by  the  program  but  are  not  used  in  the  dynamic  analysis  phase. 

In  general,  the  purpose  of  the  preceding  data  sections  is  to  provide 
information  leading  to  the  formation  of  the  system  stiffness  and  mass 
matrices  (appropriately  modified  for  displacement  boundary  conditions). 

For  example,  element  load  sets  (A,B,C,D)  may  be  constructed  as  though 
a static  case  were  to  be  considered,  but  these  data  are  not  used  in  a 
dynamic  analysis;  i.e.,  the  same  data  deck  through  Section  IV  can  be 
used  for  either  type  of  analysis.  The  concept  of  structure  loading 
conditions  is  not  defined  for  the  dynamic  case,  and  input  for  Sections 
V and  VI  must  be  prepared  specially. 


VII.  1 


VII.  DYNAMIC  ANALYSES  (continued) 


A diagonal  (lumped)  mass  matrix  is  formed  automatically  using 
element  geometry  and  assigned  material  density  or  densities.  The  mass 
matrix  so  defined  contains  only  translational  mass  coefficients 
calculated  from  tributary  element  volumes  common  to  each  node.  Known 
rotational  inertias  must  be  input  for  the  individual  nodal  degrees  of 
freedom  in  Section  V,  above. 

Non-zero  impressed  displacements  (or  rotations)  input  by  means  of 
the  BOUNDARY  element  (type  "7")  are  ignored;  instead  the  component  is 
restrained  against  motion  during  dynamic  motion  of  the  structure. 

The  program  does  not  change  the  order  of  the  system  by  performing 
a condensation  of  those  nodal  degrees  of  freedom  having  no  (zero) 
mass  coefficients;  i.e.,  a zero  mass  reduction  is  not  performed. 

No  distinction  is  made  between  static  and  dynamic  degrees  of  freedom; 
i.e.,  they  are  identical  in  sequence,  type  and  total  number. 


VII.  2 


VII.  DYNAMIC  ANALYSES  (continued) 


A.  MODE  SHAPES  AND  FREQUENCIES  (NDYN.EQ.  1 , 2 or  3)  (3I5,2F10.0) 


notes 

columns 

variable 

entry 

(1) 

1-5 

I FPR 

Flag  for  printing  intermediate  matrices 
norms,  etc.  calculated  during  the 
eigenvalue  solution ; 

EQ.O;  do  not  print 

EQ . 1 ; print 

(2) 

6-10 

I FSS 

Flag  for  performing  the  STURM  SEQUENCE 
check  ; 

EQ.O;  check  to  see  if  eigenvalues 

were  missed 

EQ.l;  pass  on  the  check 

(3) 

11  - 15 

NITEM 

Maximum  number  of  iterations  allowed 

to  reach  the  convergence  tolerance ; 
EQ.O;  default  set  to  "16" 

(4) 

16  - 25 

RTOL 

Convergence  tolerance  (accuracy)  for 
the  highest  ("nf")  requested  eigen- 

value ; 

EQ.O;  default  set  to  "l.OE-5" 

(5) 

26  - 35 

COFQ 

Cut-off  frequency  (cycles/unit  time) 
EQ.O;  NF  eigenvalues  will  be  ex- 

tracted 

GT.O;  extract  only  those  values 

below  COFQ 

(6) 

36  - 40 

NFO 

Number  of  starting  iteration  vectors 
to  be  read  from  TAPE10 

At  -5  0 

AP 

ft  s 1 f ■ > 1 

NOTES/ 

* r*  V /„ 

0*/ 

(1)  Extra  output  produced  by  the  eigenvalue  sdlutions  can  be 
requested;  output  produced  by  this  option  can  be  quite 
voluminous.  Normal  output  produced  by  the  program  consists 
of  an  ordered  list  of  eigenvalues  followed  by  the  eigen- 
vectors for  each  mode.  The  number  of  modes  found  and 
printed  is  specified  by  the  variable  "nf"  given  in  card 
columns  16-20  of  the  Master  Control  Card. 

(2)  The  program  performs  the  solution  for  eigenvalues/vectors 
using  either  of  two  (2)  distinct  algorithms: 

(a)  the  DETERMINANT  SEARCH  algorithm  requires  that 
the  upper  triangular  band  of  the  system  stiffness 
matrix  fit  into  high  speed  memory  (core);  i.e., 
one  equation  "block". 

(b)  the  SUBSPACE  ITERATION  algorithm  is  used  if  only 
portions  (fractions)  of  the  system  matrix  can  be 
retained  in  core;  i.e.,  the  matrix  (even  though 
in  band  form)  must  be  manipulated  in  blocks. 


VII.  DYNAMIC  ANALYSES  (continued) 

A.  MODE  SHAPES  AND  FREQUENCIES  (continued) 


The  program  will  automatically  select  the  SUBSPACE  ITERATION 
procedure  for  eigenvalue  solution  if  the  model  is  too  large 
for  the  in-core  algorithm. 

The  entries  I FSS  , NITEM  and  "RTOL"  are  ignored  if  the  pro- 
gram can  use  the  DETERMINANT  SEARCH  to  find  eigenvalues. 

Whether  or  not  a model  is  too  large  for  the  DETERMINANT  SEARCH 
depends  on  the  amount  of  core  allocated  (by  the  programmer 
and  not  the  user)  for  array  storage.  The  program  variable 
MTOT  equals  the  amount  of  working  storage  available  . 

Define : 


MBAND  = maximum  equation  bandwidth  (coefficients) 
(maximum  element  node  number  difference) 

X (average  number  of  degrees  of  freedom 
per  node) 

NEQ  = total  number  of  degrees  of  freedom  in 
the  mod  e 1 

= (6)  x (total  number  of  nodes)  - [number  of 
fixed  (deleted)  degrees  of  freedom] 

NEQB  = number  of  equations  per  block  of  storage 
MTOT/  MBAND/  2 (for  large  systems) 

If  NEQB  is  less  than  NEQ,  the  model  is  too  large  for  the 
DETERMINANT  SEARCH  algorithm,  and  the  SUBSPACE  ITERATION 
procedure  will  be  used. 

If  the  SUBSPACE  ITERATION  algorithm  is  used  the  user  may 
request  that  the  STURM  SEQUENCE  check  be  performed . By 
experience  the  algorithm  has  always  produced  the  lowest  NF 
eigenvalues,  but  there  is  no  formal  mathematical  proof  that 
the  calculated  NF  eigenvalues  v/ill  always  be  the  lowest  ones. 
The  STURM  SEQUENCE  check  can  be  used  to  verify  that  the 
lowest  NF  eigenvalues  have  been  obtained.  It  should  be 
noted  that  the  computational  effort  expended  in  performing 
the  STURM  SEQUENCE  check  is  not  trivial.  A factorization 
of  the  complete  system  matrix  is  performed  at  a shift  just 
to  the  right  of  the  NFth  eigenvalue. 

If  during  the  SUBSPACE  ITERATION  the  NFth  eigenvalue  fails 
to  converge  to  a tolerance  of  "RTOL"  (normally  1.0E-5,  or 
5 significant  figures)  within  MNITEMn  (normally  M16M) 
iterations,  then  the  STURM  SEQUENCE  flag  ("iFSS")  is 
ignored . 


VII. 4 


VII.  DYNAMIC  ANALYSES  (continued) 


A.  MODE  SHAPES  AND  FREQUENCIES  (continued) 

(3)  The  maximum  number  of  iterations  to  reach  convergence 
("NITEM")  applies  only  to  the  SUBSPACE  ITERATION  algorithm. 

If  cc  11-15  are  left  blank,  a default  value  of  "16"  for 
NITEM  is  assumed. 

(4)  The  convergence  tolerance  ("RTOL")  is  applicable  only  if 
the  SUBSPACE  ITERATION  algorithm  is  used.  This  tolerance 
test  applies  to  the  NFth  eigenvalue,  and  all  eigenvalues 
lower  than  the  NFth  one  will  be  more  accurate  than  RTOL. 

The  lowest  mode  is  found  most  accurately  with  precision 
decreasing  with  increasing  mode  number  until  the  highest 
requested  mode  ("nf")  is  accurate  to  a tolerance  of  RTOL. 
Iteration  is  terminated  after  cycle  number  (k+1)  if  the 
NFth  eigenvalue  (X,  say)  satisfies  the  inequality: 

t|X(k+l)  - \(k)  ] /X (k) ] < RTOL 

If  the  determinant  search  algorithm  is  used,  the  eigenpairs 
are  obtained  to  a high  precision,  which  is  indicated  by  the 
’’physical  error  bounds” 

«!  * IM2  / INJ2 

where 

= (K  - o>12M)  <J>a  , 

2 

and  (u)^  <fr . ) are  the  i ' th  eigenvalue  and  eigenvector  obtained 
in  the  solution. 

(5)  The  cut-off  frequency  ("COFQ”)  is  used  by  both  eigenvalue 
algorithms  to  terminate  computations  if  ail  eigenvalues 
below  the  specified  frequency  have  been  found. 

The  DETERMINANT  SEARCH  algorithm  computes  eigenvalues  in 
order  from  ”l”  to  ”NF,\  If  the  Nth  eigenvalue  (l£N<NF) 
has  a frequency  greater  than  "COFQ",  the  remaining  (NF-N) 
eigenvalues  are  not  computed. 


VII. 5 


VII.  DYNAMIC  ANALYSES  (continued) 


A.  MODE  SHAPES  AND  FREQUENCIES  (continued) 

The  SUBSPACE  ITERATION  algorithm  terminates  calculation 
when  the  Nth  eigenvalue  is  accurate  (i.e.,  does  not  change 
with  iteration)  to  a tolerance  of  RTOL.  As  before,  the  Nth 
eigenvalue  is  the  nearest  eigenvalue  higher  than  COFQ.  If 
the  SUBSPACE  ITERATION  solution  determines  N eigenvalues 
less  than  COFQ  (where,  N <NF)  , the  STURM  SEQUENCE  check 
(if  requested)  is  performed  using  the  Nth  (rather  than  the 
NFth)  eigenvalue  as  a shift. 

Only  those  modes  whose  frequencies  are  less  than  COFQ 
will  be  used  in  the  TIME  HISTORY  or  RESPONSE  SPECTRUM 
analyses  (Sections  VII. B and  C,  below). 

(6)  The  starting  iteration  vectors,  together  with  control 
information,  must  be  written  onto  TAPE10  before  the  program 
execution  is  started.  Appendix  B describes  the  creation  of 
TAPE10  and  gives  the  required  control  cards. 

(7)  The  program  does  not  calculate  rigid  body  modes,  i.e.  the 
system  must  have  been  restraint  so  that  no  rigid  body  modes 
are  present.  In  exact  arithmetic  the  element  dnn  of  the 
matrix  D in  the  triangular  factorization  of  the  stiffness 
matrix,  i.e.  K = LDL^,  is  zero  if  a rigid  body  mode  is  present. 
In  computer  arithmetic  the  element  dnn  is  small  when  compared 
with  the  other  elements  of  the  matrix  D.  If  this  condition 

occurs  the  program  stops  with  a message. 

* 

Note:  If  many  "artificially"  stiff  boundary  elements  are 

used,  the  average  of  the  elements  of  D will  be  artificially 
large.  Consequently,  dnn  may  be  small  in  comparison,  and 
although  no  rigid  body  modes  may  be  present,  the  program 
will  stop.  In  a dynamic  analysis  it  is  recommended  not 
to  use  very  stiff  boundary  elements. 


END  OF  DATA  CASE  INPUT  (NDYN.EQ.l) 


VII.  DYNAMIC  ANALYSES  (continued) 


B.  RESPONSE  HISTORY  ANALYSIS  (NDYN.EQ .2  or  NDYN.EQ.4) 

The  NDYN.EQ. 2 option  uses  the  (”nf”)  mode  shapes  and 
frequencies  computed  in  the  preceeding  Section  (VII. A)  to  perform 
a mode  superposition  solution  for  forced  response.  The  NDYN.EQ.4 
option  initiates  a direct  step-by-step  integration  of  the  coupled 
system  equations,  i.e.  no  eigenvalue  solution  has  been  performed 
and  no  transformation  to  the  eigenvector  basis  is  now  carried  out. 

The  data  input  is  identical  to  the  case  NDYN.EQ. 2 except  for  the 
definition  of  damping.  Dynamic  response  can  be  produced  by  two  (2) 
general  types  of  forcing  function: 

(1)  ground  acceleration  input  in  any  (or  all)  of 
the  three  (3)  global  (X,Y,Z)  directions; 

and  /or 

(2)  time  varying  loads  (forces/moments)  applied  in  any 
(or  all)  nodal  degrees  of  freedom  (except  - "slave”  - 
degrees  of  freedom) 

Time  dependent  forcing  functions  (whether  loads  or  ground 
acceleration  components)  are  described  in  two  steps.  First,  a 
number  (1  or  more  are  possible)  of  non-dimensional  time  functions 
are  specified  tabularly  by  a set  of  descrete  points:  [f(ti),t^], 

where  i = l,2,...,k.  Each  different  time  function  may  have  a different 
number  of  definition  points  (k) . A particular  forcing  function 
applied  at  some  point  on  the  structure  is  then  defined  by  a scalar 
multiplier  ("p",  say)  and  reference  to  one  of  the  input  time 
functions  (”f(t)”,  say).  The  actual  force  (or  acceleration)  at  any 
time  (V\  say)  equals  gxf(i);  f ( -t)  is  found  by  linear  interpola- 
tion between  two  of  the  input  time  points  {t  f » t ^ } , where  t^  T <;  t.+1. 

Assuming  that  the  solution  begins  at  time  zero  (0)  , an  in- 
dependent arrival  time  (ta,  where  tQ^0)  may  be  assigned  to  each 
forcing  function.  The  forcing  function  is  not  applied  to  the  system 
until  the  solution  time  ("t",  say)  equals  the  arrival  time,  tQ. 
Interpolation  for  function  values  is  based  on  relative  time  within 

the  function  table;  i.e.,  g ( t)  = f(T-t  ). 

s 

The  structure  is  assumed  to  be  at  rest  at  time  zero;  i.e., 
zero  initial  displacements  and  velocities  are  assumed  at  time  of 
solution  start. 

The  following  data  are  required  for  a Forced  Dynamic  Response 

Analysis : 

1.  Control  Card  (5I5,2Fl0.0) 
notes  columns  variable  entry 

(1)  1 - 5 NFN  Number  of  different  time  functions; 

GE . 1 
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VII.  DYNAMIC  ANALYSES  (continued) 


B.  RESPONSE  HISTORY  ANALYSIS  (continued) 


notes 

columns 

variable 

entry 

(2) 

6-10 

NGM 

Ground  motion  indicator; 

(3) 

11  - 15 

NAT 

EQ.O;  no  ground  motion  is  input 
EQ.l;  read  ground  motion  control 
card  (Section  VII. B. 3) 
Number  of  different  arrival  times 

(4) 

16  - 20 

NT 

for  the  forcing  functions; 

EQ.O;  all  arrival  times  are  zero 
Total  number  of  solution  time  steps 

(5) 

21  - 25 

NOT 

GE.  1 

Output  print  interval  for  stresses, 

(4) 

26  - 35 

DT 

displacements , etc . 

GE.l  and  LE.NT 
Solution  time  step,  At; 

(6) 

36  - 45 

DAMP 

GT.O 

Damping  factor  to  be  applied  to  all 

In  case 

of  NDYN.EQ 

. 4 use 

NF  modes  (fraction  of  critical) ; 
GE.O 

(6) 

36  - 45 

ALPHA 

Damping  factor  a 

(7) 

46  - 55 

BETA 

Damping  factor  g 

NOTES/ 

(1) 

At  least 

one  (1)  time 

function  must  be  :'nput. 

(2) 


(3) 


(4) 


If  no  ground  acceleration  acts  on  the  structure,  set  mNGM" 
to  zero  and  skip  Section  VII. B. 3,  below.  Both  ground 
acceleration  and  nodal  force  input  are  allowed. 

If  no  arrival  time  values  are  input,  all  forcing  functions 
begin  acting  on  the  structure  at  time  zero.  The  same 
arrival  time  value  may  be  referenced  by  different  forcing 
functions,  NAT  determines  the  number  of  non-zero  entries 
that  the  program  expects  to  read  in  Section  VII. B. 4,  below. 

The  program  performs  a step-by-step  integration  of  the 
equations  of  motion  using  a scheme  which  is  unconditionally 
stable  with  respect  to  time  step  size,  At.  In  case  NDYN.EQ.2 
the  modal  uncoupled  equations  of  motion  are  integrated.  In 
case  NDYN.EQ.4  the  coupled  system  equations  are  integrated. 

If  T is  the  period  of  the  highest  numbered  mode  (normally 
the  NFth  mode)  that  is  to  be  included  in  the  response 
calculation,  At  should  be  chosen  such  that  At/T  <0.1.  A 
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VII.  DYNAMIC  ANALYSES  (continued) 


B.  RESPONSE  HISTORY  ANALYSIS  (continued) 

larger  time  step  (i.e.,  At  > 0 i. IT)  will  not  cause  failure 
(instability) , but  participation  of  the  higher  modes  is 
"filtered"  from  the  predicted  response.  In  general,  with 
increasing  time  step  size  the  solution  is  capable  of 
capturing  less  of  the  higher  frequency  participation. 

(5)  The  program  computes  system  displacements  at  every  solution 
time  step,  but  printing  of  displacements  and  recovery  of 
element  stresses  is  only  performed  at  solution  step  inter- 
vals of  "NOT".  NOT  must  be  at  least  ”l"  and  is  normally 
selected  in  the  range  of  10  to  100. 

(6)  The  damping  factor  ("DAMP")  is  applied  to  all  NF  modes. 

The  admissible  range  for  DAMP  is  between  0.0  (no  damping) 
and  1.0  (100%  of  critical  viscous  damping). 

(7)  In  case  NDYN.EQ.4  the  damping  matrix  used  is  C = Of  M + gK, 
where  a and  g are  defined  in  columns  36  to  55. 
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VII.  DYNAMIC  ANALYSES  (continued) 


B.  RESPONSE  HISTORY  ANALYSIS  (continued) 


2. 

Time- 

Varying  Load 

Cards  (4I5,F10.0) 

notes 

columns 

variable 

ent  ry 

j- 

(i) 

1 

- 5 

N P 

Nodal  point  number  where  the  load 
component  (force  or  moment)  is  applied  ; 
GE.l  and  LE.NUMNP 

h 

(2) 

10 

IC 

EQ.O  last  card  only 

Degree  of  freedom  number; 

GE.l  and  LE.6 

( 6X=1 , 6Y=2 , 6Z=3  , $X=4  , $>Y=5  , $Z=6) 

(3) 

11 

- 15 

IFN 

Time  function  number; 
GE.l  and  LE.NTFN 

(4) 

16 

- 20 

IAT 

Arrival  time  number; 

1 

(5) 

21 

- 30 

P 

EQ.O;  load  applied  at  solution  start 

GE.l;  non-zero  arrival  time 

Scalar  multiplier  for  the  time  function 
EQ.O;  no  load  applied 

NOTES/ 

(1)  One  card  is  required  for  each  nodal  degree  of  freedom 
having  applied  time  varying  loads.  Cards  must  be  input 
in  ascending  node  point  order.  This  sequence  of  cards 
must  be  terminated  with  a blank  card.  A blank  card  must  be 
supplied  even  if  no  loads  are  applied  to  the  system, 

(2)  The  same  node  may  have  more  than  one  degree  of  freedom 
loaded;  arrange  degrees  of  freedom  references  ("ic") 

in  ascending  sequence  at  any  given  node. 

(3)  A non-zero  time  function  number  ("iFN")  must  be  given  for 
each  forcing  function.  IFN  must  be  between  1 and  NFN. 

The  time  functions  are  input  tabularly  in  Section  VII. B. 5, 
below.  Function  values  at  times  between  input  time  points 
are  computed  with  linear  interpolation. 

(4)  If  "lATn  is  zero  (or  blank),  the  forcing  function  is  assumed 
to  act  on  the  system  beginning  at  time  zero.  If  IAT  is 
input  as  a positive  integer  between  1 and  NAT,  the  IATth 
arrival  time  (defined  in  Section  VII. B. 4,  below)  is  used 

to  delay  the  application  of  the  forcing  function;  i.e. , 
the  forcing  function  begins  acting  on  the  structure  when  the 
solution  reaches  the  IATth  arrival  time  value. 

(5)  The  actual  magnitude  of  force  (or  moment)  acting  on  the 

model  at  time,  t,  equals  the  product:  (" P M)  x (value  of 

function  number  MIFNM  at  time,  t) . 
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VII.  DYNAMIC  ANALYSES  (continued) 


B.  RESPONSE  HISTORY  ANALYSIS  (continued) 


3.  Ground  Motion  Control  Card  (615) 


notes 

columns 

variable 

entry 

a) 

1 - 

5 

NFNX 

Time  function  number  describing  the 
ground  acceleration  in  the  X-direction 

6 - 

10 

NFNY 

Time  function  number  describing  the 
ground  acceleration  in  the  Y-direction 

11  - 

15 

NFNZ 

Time  function  number  describing  the 
ground  acceleration  in  the  Z-direction 

(2) 

16  - 

20 

NATX 

Arrival  time  number,  X-direction 

21  - 

25 

NATY 

Arrival  time  number,  Y-direction 

26  - 

30 

NATZ 

Arrival  time  number,  Z-direction 

NOTES/ 

(1)  This  card  must  be  input  only  if  the  ground  motion 
indicator  (’*NGM  ) was  set  equal  to  one  (1)  on  the 
Control  Card  (Section,  VII. B.l,  above).  A zero 
time  function  number  indicates  that  no  ground  motion 
is  applied  for  that  particular  direction. 

(2)  Zero  arrival  time  references  mean  that  the  ground 
acceleration  (if  applied)  begins  acting  on  the 
structure  at  time  zero  (0).  Non-zero  references 
must  be  integers  in  the  range  1 to  NAT. 
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VII.  DYNAMIC  ANALYSES  (continued) 

B.  RESPONSE  HISTORY  ANALYSIS  (continued) 
4.  Arrival  Time  Cards 


a . 

card  one 

(8F10.0) 

notes 

columns 

variable 

ent  ry 

(i) 

1 

- 10 

AT  ( 1 ) 

Arrival 

t ime 

number 

1 

11 

- 20 

AT  (2) 

Arrival 

t ime 

number 

2 

71 

- 80 

AT  (8) 

Arri va 1 

t ime 

number 

8 

b. 

card  two 

(8F10.0)  - 

(required  if 

NAT 

notes 

columns 

variable 

entry 

1 

- 10 

AT  (9) 

Arrival 

time 

number 

9 

etc.  etc. 


NOTES. 

(1)  The  entry  ("NAT")  given  in  cc  11-15  on  the  Control  Card 
(Section  VII. B.l,  above)  specifies  the  total  number  of 
arrival  time  entries  to  be  read  in  this  section.  Input 
as  many  cards  as  are  required  to  define  NAT  different 
arrival  times,  eight  (8)  entries  per  card.  If  no  arrival 
times  were  requested  (NAT.EQ.O) , supply  one  (1)  blank 
card  in  this  section. 
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VII.  DYNAMIC  ANALYSES  (continued) 

B.  RESPONSE  HISTORY  ANALYSIS  (continued) 

5.  Time  Function  Definition  Cards 

Supply  one  set  (card  1 and  card  (s)  2)  of  input  for 
each  of  the  "NFNM  time  functions  requested  in  cc  1-5  of  the 
Control  Card  (Section  VII. B.l,  above).  At  least  one  set  of  time 
function  cards  is  expected  in  this  section.  The  card  sets  are  input 
in  ascending  function  number  order. 

a.  card  1 (15 , FlO . 0 , 12A5) 


notes 

columns 

vari able 

entry 

(i) 

1 - 

5 

NLP 

Number  of  function  definition  points; 
GE.2 

(2) 

6 - 

15 

SFTR 

Scale  factor  to  be  applied  to  f(t) 
values  ; 

EQ.O;  default  set  to  M1.0M 

16  - 

75 

HED  (12) 

Label  information  (to  be  printed  with 

output)  describing  this  function  table 

NOTES/ 

(1)  At  least  two  points  (i.e.,  2 pairs:  f(ti),ti)  must  be 

specified  for  each  time  function.  Less  than  two  points 
would  preclude  linear  interpolation  in  the  table  for  f(t). 

(2)  The  scale  factor  "SFTR,r  is  used  to  multiply  function 
values  only;  i.e.,  input  time  values  are  not  changed.  If 
the  scale  factor  is  omitted,  SFTR  is  re-set  by  the  program 
to  "1.0"  thereby  leaving  input  function  values  unchanged. 
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VII.  DYNAMIC  RESPONSE  ANALYSES 


B.  RESPONSE  HISTORY  ANALYSIS  (continued) 


5.  Time  Function  Definition  Cards  (continued) 
b.  card  (s)  2 (12F6.0) 


notes 

columns 

variable 

(i) 

1-6 

T (1) 

7-12 

F (1) 

13  - 18 

T (2 ) 

19  - 24 

F (2 ) 

etc . 

NOTES  ' 


entry 

Time  values  at  point  1,  t^ 
Function  value  at  point  1,  f ( t j ) 
Time  value  at  point  2,  t2 
Function  value  at  point  2,  f ( 1 2 ) 
etc . 


(1)  Input  as  many  card  (s)  2 as  are  required  to  define 
NLP  pairs  of  t^,f(t^),  six  (6)  pairs  per  card. 

Pairs  must  be  input  in  order  of  ascending  time  value. 
Time  at  point  one  must  be  zero,  and  care  must  be  taken 
to  ensure  that  the  highest  (last)  input  time  value 
(t^Lp}  is  at  least  equal  to  the  value  of  time  at  the 
end  of  solution;  i.e.,  the  time  span  for  all  functions 
must  cover  the  solution  time  period  otherwise  the 
interpolation  for  function  values  will  fail.  For 
the  case  of  non-zero  arrival  times  associated  with 
a particular  function,  the  shortest  arrival  time 
reference  ("tA",  say)  plus  (+)  the  last  function 
time  ( ’t ^LpM)  must  at  least  equal  the  time  at  the 
end  of  the  solution  period  (t£|s0,  say);  i.e., 

tA  + tNLP  * tEND  • 
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VII.  DYNAMIC  ANALYSES  (continued) 


B.  RESPONSE  HISTORY  ANALYSIS  (continued) 

6.  Output  Definition  Cards 

To  minimize  the  amount  of  output  which  would  be 
produced  by  the  program  if  all  displacements,  stresses,  etc. 
were  printed,  output  requests  for  specific  components  must  be 
given  in  this  section.  Time  histories  for  selected  components 
appear  in  tables;  the  solution  step  output  printing  interval 
is  specified  as  "NOT"  which  is  given  in  cc  21-25  of  the  Control 
Card  (Section  VII. B.l,  above). 

a.  displacement  output  requests 
(1)  control  card  (215) 
notes  columns  variable  entry 

(1)  1-5  KKK  Output  type  indicator; 

EQ.l;  print  histories  and  maxima 

EQ.2;  printer  plot  histories  and 

recovery  of  maxima 
EQ.3;  recover  maxima  only 

(2)  6-10  ISP  Printer  plot  spacing  indicator 


NOTES 

(1)  The  type  of  output  to  be  produced  by  the  program 
applies  to  all  displacement  requests.  KKK . EQ.O 
is  illegal. 

(2)  "isp"  controls  the  vertical  (down  the  page)  spacing 
for  printer  plots.  Output  points  are  printed  on 
every  (ISP+l)th  line.  The  horizontal  (across  the 
page)  width  of  printer  plots  is  a constant  ten  (10) 
inches  (100  print  positions).  ISP  is  used  only  if 
KKK. EQ.2. 
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VII.  DYNAMIC  ANALYSES  (continued) 

B.  RESPONSE  HISTORY  ANALYSIS  (continued) 

6.  Output  Definition  Cards 

a.  displacement  output  requests  (continued) 

(2)  node  displacement  request  cards  (715) 

notes  columns  variable  entry 

Node  number 
GE.l  and  LE.NLfMNP 
EQ.O  last  card  only 

Displacement  component,  request  1 
Displacement  component,  request  2 
Displacement  component,  request  3 
Displacement  component,  request  4 
Displacement  component,  request  5 
Displacement  component,  request  6 
GE.l  and  LE.6 

EQ.O  terminates  requests  for  the  node 

NOTES/ 

(1)  Only  those  nodes  at  which  output  is  to  be  produced 
(or  at  which  maxima  are  to  be  determined)  are  entered 
in  this  section.  Cards  must  be  input  in  ascending 
node  number  order.  Node  numbers  may  not  be  repeated. 

This  section  must  be  terminated  with  a blank  card. 

(2)  Displacement  component  requests  ("ic")  range  from  1 to  6 , 
where  1 =6X  ,2  = 6Y  , 3 = 6Z,4=$X  , 5=$Y,6=$Z.  The  first  zero  (or' 
blank)  encountered  while  re'ading  1C  (1)  , IC  (2)  , . , . , IC  (6) 
terminates  information  for  the  card.  Displacement 
components  at  a node  may  be  requested  in  any  order.  As 

an  example,  suppose  that  6Y,  $X  and  §Z  are  to  be  output  at 
node  34;  the  card  could  be  written  as  /34 , 2 ,4 , 6 , 0/,  or 
/34 ,6,4 ,2 ,0/,  etc.  but  only  four  (4)  fields  would  have 
non-zero  entries. 


1 - 

5 

NP 

6 - 

10 

IC(1) 

11  - 

15 

IC  (2) 

16  - 

20 

IC  (3) 

21  - 

25 

IC  (4 ) 

26  - 

30 

IC  (5) 

31  - 

36 

IC  (6) 
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VII,  DYNAMIC  ANALYSES  (continued) 

B.  RESPONSE  HISTORY  ANALYSIS  (continued) 

6.  Output  Definition  Cards 

b.  element  stress  component  output  requests 

(1)  control  card  (215) 

notes  columns  variable  entry 

Output  type  indicator; 

EQ.l;  print  histories  and  maxima 

EQ.2;  printer  plot  of  histories 

and  recovery  of  maxima 
EQ.3;  recover  maxima  only 
Plot  spacing  indicator 

NOTES/ 

(1)  See  Section  VI I . B. 6 . a . (1) , above. 

(2)  element  stress  component  request  cards  (1315) 

„ fr  Requests  are  grouped  by  element  type; 

NELTYP  groups  must  be  input.  A group  consists  of  a series  of 
element  stress  component  request  cards  terminated  by  a blank  card. 
Element  number  references  within  an  element  type  (TRUSS,  say) 
grouping  must  be  in  ascending  order.  Element  number  references  may 
be  omitted  but  not  repeated.  The  program  processes  element  groups 
in  the  same  order  as  originally  input  in  the  Element  Data  (Section  IV, 
above).  I f no  output  is  to  be  prod-u^ed  for  an  element  type,  then  input 
one  blank  card  for  its  groups 

notes  columns  variable  entry 

(1)  1-5 


(2)  6-10 
11  - 15 


61  - 65 


Element  number 
GE.  1 

EQ.O;  last  card  in  the  group  only 
Stress  component  number  for  output, 
request  1 

Stress  component  number  for  output, 
request  2 


Stress  component  number  for  output, 
request  12 


(1)  1-5  KXK 


6 - 10  ISP 
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VII.  DYNAMIC  ANALYSES  (continued) 


B.  RESPONSE  HISTORY  ANALYSIS  (continued) 

6.  Output  Definition  Cards 

b.  element  stress  component  output  requests 
(2)  request  cards  (continued) 

NOTES/ 

(1)  Terminate  each  different  element  output  group  (type) 
with  a blank  card.  Elements  within  a group  must  be 
in  element  number  order  (ascending)  ; element  number 
repetitions  are  illegal. 

(2)  The  first  zero  (or  blank)  request  encountered  while 
reading  IS(1),  18(2),...,  IS(12)  terminates  infor- 
mation for  the  card.  No  more  than  twelve  (12)  different 
components  may  be  output  for  any  one  of  the  elements. 
Table  VII. 1 lists  the  stress  component  numbers  and 
corresponding  descriptions  for  the  various  element 
types.  Some  element  types  (TRUSS,  for  example)  have 
fewer  than  12  components  defined;  only  the  stress 
component  numbers  listed  in  Table  VII. 1 are  legal 

ref e rences . 


END  OF  DATA  CASE  INPUT  (NDYN.EQ.2  or  NDYN . EQ,  4 ) 
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TABLE  VII . 1 


MAXIMUM  STRESS 

ELEMENT  NUMBER  OF  COMPONENT  OUTPUT 

typf  COMPONENTS  NUMBER  SYMBOL  DESCRIPTION 

1.  TRUSS  (2)  (I)  (P/A  ) AXIAL  STRESS 

(2)  IP  I AXIAL  FORCE 

2.  REAM  (12)  ( I)  (Pit l ) I 1-FORCE  AT  END  I 

( 2)  ( V 2 ( I ) ) 2-SHEAR  AT  END  I 

( 3 ) ( V 3 ( I ) ) 3-SHEAR  AT  END  I 

( A)  ITl(I)  ) 1-TORQUF  AT  END  I 

( 5)  ( M2 ( I ) ) 2-MOMENT  AT  END  I 

( 6)  ( M 3 ( I ) ) 3-MOMENT  AT  END  I 

( 7)  (PKJI  ) 1-FORCE  AT  END  J 

( 5 ) ( V 2 ( J ) ) 2-SHEAR  AT  END  J 

( 9)  ( V 3 ( J ) ) 3-SHEAR  AT  END  J 

(10)  ( T 1 ( J ) ) 1-TOPOUE  AT  END  J 

(11)  (M2(J>  ) 2-MOMENT  AT  END  J 

(12)  ( M3 ( J ) ) 3-MOMENT  AT  END  J 


3.  PI  A\r  - 
S T R c < S / 
PLAN-- 
strain 

A.  AXISY^-  (20) 
« to  j r; 


( 5)  (11-SI  ) V-  STRESS  AT  POINT  1 

( 6)  (22 -SI  ) U-  STRESS  AT  POINT  1 

( 7)  (33-SI  ) T-  STRESS  AT  POINT  1 

( 8)  (12 -SI  ) JV-STRESS  AT  POINT  1 

{ 9)  (11-S2  ) V-  STRESS  AT  POINT  2 

(10)  (22-S2  ) U-  STRESS  AT  POINT  2 

(11)  (33-S2  ) T-  STRESS  AT  POINT  2 

(12)  (12-S2  ) UV-STRESS  AT  POINT  2 

(13)  (11-S3  ) V-  STRESS  AT  POINT  3 

( 1 A ) (22  - S3  ) U-  STRESS  AT  POINT  3 

(IB)  ( 33  - S3  ) T-  STRESS  AT  POINT  3 

(16)  ( 12 -S3  ) UV-STRESS  AT  POINT  3 


( 1)  (11 -SO  ) V-  STRESS  AT  POINT  0 
( 2)  ( 22 -SO  ) U-  STRESS  AT  POINT  0 
( 3)  ( 33  - SO  ) T-  STRESS  AT  POINT  0 
( A)  { 12 -SO  ) UV-STRESS  AT  POINT  0 
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MAXIMUM 

STRESS 

FLrMF  NT 

NUMBER  OF 

COMPONENT 

OUTPUT 

T YPC 

COMPONENTS 

NUMBER 

SYMBOL 

D E S C R 

I 

P T I 0 N 

( 17  ) 

(V  -S4  ) 

V-  STRESS 

AT 

POINT  4 

( 18) 

(U  -S4  ) 

U-  STRESS 

AT 

POINT  4 

( 1 9 1 

(T  -S4  ) 

T-  STRESS 

AT 

POINT  4 

(20) 

(UV-S4  ) 

UV-STRESS 

AT 

POINT  4 

* 

* $ 

* $ $ $ 

# * # * 

* a 

* * # * 

* 

# $ # 

F I GHT 

(12) 

( 1) 

(XX-SL1) 

XX-STRESS 

AT 

LOCATION 

1 

NODE 

( 2) 

( YY-SL1 ) 

YY-STRESS 

AT 

LOCATION 

1 

0P  ICK 

( 3) 

( ZZ-SL1) 

ZZ-STRESS 

AT 

LOCATION 

1 

( 4) 

(XY-SL1  ) 

XY-STRESS 

AT 

LOCATION 

1 

( 5) 

(YZ-SL1) 

YZ-STRESS 

AT 

LOCATION 

l 

( 6) 

( ZX-SL1) 

ZX-STRE  SS 

AT 

LOCATION 

l 

( 7) 

( XX-SL2) 

XX-STRESS 

AT 

LOCATION 

2 

( 8) 

(YY-SL2I 

YY-STRESS 

A T 

LOCATION 

2 

( 9) 

( ZZ-SL2  ) 

ZZ-STRESS 

AT 

LOCATION 

2 

( 10) 

( XY-SL2) 

XY-STRESS 

AT 

LOCATION 

2 

(11) 

(YZ-SL2) 

YZ-STRESS 

AT 

LOCATION 

2 

< 12) 

( ZX-SL2) 

ZX-STRESS 

AT 

LOCATION 

2 

♦ 

* * 

* * * * 

<=  * $ * 

* $ i 

* * * * 

* 

* * * 

. PLATE/ 

( 6) 

( 

1 ) 

(XX-S/R) 

XX-STRESS 

RESUL  TANT 

SHELL 

( 

2 ) 

( YY-S/R) 

YY-STRESS 

RESULTANT 

( 

3 ) 

(XY-S/R) 

XY-STRESS 

RESULTANT 

( 

4 ) 

( XX-M/R  ) 

XX-MOMENT 

resultant 

( 

5) 

( YY-M/R) 

YY-MOMENT 

RESULTANT 

( 

6 ) 

( XY-M/R) 

XY-MOMENT 

RESULTANT 

* <=  + 

♦ * * 

* 

# $ 

r ^ V 

* * * * 

♦ £ $ 

* * 

. BOUN- 

(  2) 

( 

1 ) 

( BDRY-F ) 

BOUNDARY  ' 

PQRCE 

DARY 

( 

2 ) 

( RORY-M) 

BOUNDARY 

FOMENT 

a $ * 

* * * 

* 

$ * 

$ * $ 

$ * * 

if  if  * * 

if  •? 

. THICK 

( 

1 1 

(SXX (0)  ) 

XX-STRESS 

4 T CENTROID 

(0) 

SHELL 

(42) 

( 

2 ) 

( SYY( 0) ) 

YY-STRESS 

AT  CENTROID 

( 0 ) 

AND 

( 

3 ) 

(SZZ(O)  ) 

ZZ-STRESS 

AT  CENTROID 

( 0) 

3-DIM. 

( 

4) 

(SXY(O)  ) 

XY-STRESS 

AT  CENTROID 

( 0 ) 

( 

5) 

( S YZ ( 0)  ) 

YZ-STRESS 

AT  CENTROID 

(0  ) 

( 

6) 

(SZX(O) ) 

ZX-STRESS 

AT  CENTROID 

( 0 ) 

( 

7 ) 

( SXX(  1)  ) 

XX-STRESS 

AT  CENTER  OF 

FACE  1 
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ELEMENT 

TYPE 


M A X I MUM 

STRESS 

NUMBER  OF 

COMPONENT 

OUTPUT 

COMPONENTS 

NUMBER 

SYMBOL 

( 9 ) 

( SYY( 1) ) 

( 9) 

( SZZ(l) ) 

( 10) 

( S XY  ( 1 ) ) 

( 11  ) 

( SYZ(  1 ) ) 

(12) 

( SZXl 1 ) ) 

(13) 

( SXX{ 2) ) 

(14) 

( SYY ( 2 ) ) 

(15) 

( SZZ ( 2) ) 

( 16  ) 

( SXY(2) ) 

(17) 

( S YZ { 2 ) ) 

( 19  ) 

( SZX(  2)  I 

( 19) 

( SXX( 3) ) 

(20  ) 

( S YY ( 3 ) ) 

( 21  ) 

( SZZ ( 3 ) ) 

(22) 

( SXY( 3) ) 

(23  ) 

(SYZ(31 ) 

( 24) 

( SZX( 3 ) ) 

(25) 

( S XX ( 4 ) ) 

(26) 

( SYY ( 4 ) ) 

(27  ) 

( SZZ (4)  ) 

(28) 

( SXY{  4)  ) 

(29  ) 

( S YZ ( 4 ) ) 

( 30) 

( S Z X ( 4 ) ) 

(31  > 

( SXX ( 5 ) ) 

( 32  ) 

( SYY( 5) ) 

( 33  ) 

( S Z 7 ( 5 ) ) 

( 34) 

< SXY(5) ) 

( 35) 

( S YZ l 5 ) ) 

( 36  ) 

( S Z X { 5 ) ) 

( 37  ) 

( SXX ( 6 ) ) 

( 38  ) 

1 SYY (6)  ) 

( 39) 

( SZZ (6)  ) 

( 40  ) 

( S X Y { 6 ) ) 

( 41  ) 

( S YZ ( 6 ) ) 

(42  ) 

( SZXl 6)  ) 

DESCRIPTION 

YY-STRESS  AT  CENTER  OF  FACE  I 
ZZ-STRESS  AT  CENTER  OF  FACE  1 
XY-STRESS  AT  CENTER  OF  FACE  I 
YZ-STRESS  AT  CENTER  OF  FACE  1 
ZX-STRESS  AT  CENTER  OF  FACE  1 

XX-STRESS  AT  CENTER  OF  FACE  2 
YY-STRESS  AT  CENTER  OF  FACE  2 
ZZ-STRESS  AT  CENTER  OF  FACE  2 
XY-STRESS  AT  CENTER  OF  FACE  2 
YZ-STRESS  AT  CENTER  OF  FACE  2 
ZX-STRESS  AT  CENTER  OF  FACE  2 

XX-STRESS  AT  CENTER  OF  FACE  3 
YY-STRESS  AT  CENTER  OF  FACE  3 
ZZ-STRESS  AT  CENTER  OF  FACE  3 
XY-STRESS  AT  CENTER  OF  FACE  3 
YZ-STRESS  AT  CENTER  OF  FACE  3 
ZX-STRESS  AT  CENTER  OF  FACE  3 

XX-STRESS  AT  CENTER  OF  FACE  4 
YY-STRESS  AT  CENTER  OF  FACE  4 
ZZ-STRESS  AT  CENTER  OF  FACE  4 
XY-STRESS  AT  CENTER  OF  FACE  4 
YZ-STRESS  AT  CENTER  OF  FACE  4 
ZX-STRESS  AT  CENTER  OF  FACE  4 

XX-STRESS  AT  CENTER  OF  FACE  5 
YY-STRESS  AT  CENTER  OF  FACE  5 
ZZ-STRESS  AT  CENTER  OF  FACE  5 
XY-STRF'SS  AT  CENTER  OF  FACE  5 
YZ-STRESS  AT  CENTER  OF  FACE  5 
ZX-STRESS  AT  CENTER  OF  FACE  5 

XX-STRESS  AT  CENTER  OF  FACE  6 
YY-STRESS  AT  CENTER  OF  FACE  6 
ZZ-STRESS  AT  CENTER  Or  FACE  6 
XY-STRESS  AT  CENTER  OF  FACE  6 
YZ-STRESS  AT  CENTER  OF  FACE  6 
ZX-STRESS  AT  CENTER  OF  FACE  6 


V 1 1 . 2 1 


****** 
9 . i>  J OF 

A.  TANGENT  (12) 


B.  BEND  (18) 


****** 

****** 


* * 

* * * 

« 

$ fc  $ 

4 

* 

$ 

* 

* * 

( 1 ) 

( PX  ( I ) 

) 

X-FORCE 

AT 

END 

l 

( 2) 

( V Y(  I ) 

) 

Y-SHEAR 

AT 

ENO 

I 

( 3) 

(VZ  ( I ) 

) 

Z-SHEAR 

AT 

END 

I 

( 4 ) 

( T X ( I ) 

) 

X-TORQUE 

AT 

ENO 

I 

( 5 ) 

( MY(  I ) 

) 

Y-MOMENT 

AT 

ENO 

l 

( 6 ) 

(MZ(I) 

) 

Z-MOMENT 

AT 

ENO 

I 

( 7) 

( PX ( J ) 

) 

X-FORCE 

AT 

ENO 

J 

< 8) 

( V Y ( J ) 

) 

Y-SHEAR 

AT 

ENO 

J 

1 

( 9) 

(VZ1 J) 

) 

Z-SHEAR 

AT 

END 

J 

j 

(10) 

( T X { J ) 

) 

X-TORQUE 

AT 

ENO 

J 

! 

( 11  ) 

( MY ( J I 

) 

Y-MOMENT 

AT 

ENO 

J 

i 

( 12  ) 

(MZ( J) 

) 

Z-MOMENT 

AT 

END 

J 

( 1 ) 

( PX  ( I ) 

) 

X-FORCE 

AT 

END 

I 

i 

! 

i 

( 2) 

( V Y ( I ) 

) 

Y-SHEAR 

AT 

ENO 

I 

1 

( 3) 

( VZ  ( I ) 

) 

Z-SHEAR 

AT 

END 

I 

J 

( 4 ) 

( T X ( I ) 

) 

X-TORQUE 

AT 

END 

I 

( 8) 

( MY(  I ) 

) 

Y-MOMENT 

AT 

ENO 

I 

( 6 ) 

( M Z ( I > 

) 

Z-MOMENT 

AT 

ENO 

I 

( 7) 

C P X ( C ) 

) 

X-FORCE 

AT 

CENTER 

OF 

ARC 

( 8) 

( V Y ( C ) 

) 

Y-SHEAR 

AT 

CENTER 

OF 

ARC 

( 9) 

<VZ(C) 

> 

Z-SHEAR 

AT 

CENTER 

OF 

ARC 

(10) 

( T X ( C) 

) 

X-TORQUE 

AT 

CENTER 

OF 

ARC 

( 11  ) 

( MY  ( C ) 

) 

Y-MOMENT 

AT 

CENTER 

OF 

ARC 

( 12  ) 

(MZ(C) 

) 

z-moment 

AT 

CENTER 

OF 

ARC  | 

( 13  ) 

( P X ( J ) 

) 

X-FORCE 

AT 

END 

J 

i 

t 

(14) 

( V Y(  J ) 

) 

Y-SHEAR 

AT 

END 

J 

; 

( 15  ) 

( V Z ( J ) 

) 

Z-SHEAR 

AT 

END 

J 

i 

1 

( 16  ) 

( T X ( J ) 

) 

X-TORQUE 

AT 

END 

J 

j 

( 17) 

<MY{  J) 

) 

Y-MOMENT 

AT 

END 

J 

( 

( IP  ) 

( MZ  ( J ) 

) 

Z-MOMENT 

AT 

END 

J 

i 

1 

* * 

* * * 

* 

* * * 

* 

* 

* 

* 

* * j 

* * 

* * * 

* 

* * * 

* 

* 

*r 

* 

* * f 
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VII.  DYNAMIC  ANALYSES  (continued) 


C.  RESPONSE  SPECTRUM  ANALYSIS  (NDYN.EQ.3) 

This  option  combines  all  (NF)  mode  shapes  and  frequencies 
computed  during  the  eigenvalue  solution  (Section  VII. A)  to  calculate 
R.M.S.  stresses/deflections  due  to  an  input  displacement  (or  accelera- 
tion) spectrum.  The  input  spectrum  is  applied  in  varying  proportions 
in  the  global  X,Y,Z  directions.  For  the  case  of  a non-zero  cut-off 
frequency  "COFQ"  (Section  VII. A),  only  those  modes  whose  frequencies 
are  less  than  COFQ  will  be  combined  in  the  R.M.S.  analysis. 


1. 

Control  Card 

(3F10.0, 15) 

notes 

columns 

variable 

entry 

(i) 

1 

- 10 

EX 

Factor  for  X-direction  input 

11 

- 20 

FY 

Factor  for  Y-direction  input 

21 

- 30 

FZ 

Factor  for  Z-direction  input 
EQ.O;  not  acting 

(2) 

31 

- 35 

1ST 

Input  spectrum  type; 

EQ.O;  displacement  vs.  per 

EQ.l;  acceleration  vs.  per 

NOTES/ 

(1)  All  three  (3)  direction  factors  may  be  non-zero  in 
which  case  the  entries  represent  the  X.Y.Z  components 
of  the  input  direction  vector. 

(2)  "1ST"  defines  the  type  of  spectrum  table  to  be  input 

immediately  following.  The  spectral  displacements 
("S'')  and  accelerations  ("sa")  are  assumed  to  be 
related  as  follows:  Sa  - (4 n^f^) (S^) . 
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VII.  DYNAMIC  ANALYSES  (continued) 

C.  RESPONSE  SPECTRUM  ANALYSIS  (continued) 
2.  Spectrum  Cards 


a . 

heading  card 

(12A6) 

notes 

columns 

variable 

entry 

1-72 

HED  (12 ) 

Heading  information  used  to  label 
the  spectrum  table 

b. 

control  card 

(15 , FlO , 0) 

notes 

columns 

variable 

entry 

1-5 

NPTS 

Number  of  definition  points  in  the 
spect rum  table ; 

GE.2 

6-15 

SFTR 

Scale  factor  used  to  adjust  the 
displacement  (or  acceleration) 
ordinates  in  the  spectrum  table 
EQ.1.0;  no  adjustment 

c. 

spectrum  data 

(2  F10.0) 

notes 

columns 

variable 

entry 

(i) 

1-10 

T 

Period  (reciprocal  of  frequency) 

(2) 

11  - 20 

S 

Value  of  displacement  (or  acceleration 
if  IST.EQ.l) 

NOTES/ 

(1)  Input  one  definition  point  per  card;  "NPTS"  cards 
are  required  in  this  section.  Cards  must  be  arranged 
in  ascending  value  of  period. 

(2)  "s"  is  interpreted  to  be  a displacement  quantity 
if  "1ST"  was  input  as  zero.  For  IST.EQ.l,  "s" 

is  an  acceleration  value. 


END  OF  DATA  CASE  INPUT  (NDYN.EQ.3) 
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APPENDIX  A - CONTROL  CARDS  AND  DECK  SET-UP  FOR  DYNAMIC  ANALYSIS  RE-START 


The  purpose  of  this  appendix  is  to  describe  the  procedure 
(including  control  cards  and  deck  set-up)  required  for  program  re- 
start following  an  eigenvalue/eigenvector  extraction  analysis.  The 
re-start  option  has  been  included  in  the  program  in  order  to  make 
a repeated  forced  response  or  spectrum  analysis  possible  without 
solving  each  time  for  the  required  eigensystem.  For  med ium- to-large 
size  models,  eigenvalue  solution  is  quite  costly  when  compared  to  the 
forced  response  calculations;  hence,  excessive  costs  may  be  incurred 
if  the  entire  job  has  to  be  re-run  due  to  improper  specification  of 
forcing  functions  or  input  spectra,  inadequate  requests,  etc.  For 
small  models  (less  than  100  nodes,  say)  the  extra  effort  required 
for  re-start  is  normally  not  justified. 

A complete  dynamic  analysis  utilizing  the  re-start  feature 
requires  that  the  job  be  run  in  two  (2)  steps: 

J0B(1):  Eigenvalue  extraction  solution  only,  after  which 

program  files  TAPEl , TAPE2  , TAPE7  , TAPE8  , and  TAPE  9 
are  saved  on  the  re-start  tape. 

.JOBS  (2):  Re-instatement  of  program  files  TAPEl  , TAPE2  , TAPE7  , TAPE8  , 

and  TAPE9  from  the  re-start  tape  followed  by  a Dynamic 
Response  Analysis  (NDYN.EQ.-2)  or  a Response  Spectrum  Analysis 
(NDYN.EQ.-3) . 

For  a given  model,  the  first  job  [J0B(1)]  creating  the  re-start 
tape  is  run  only  once.  The  re-start  tape  then  contains  all  the 
initial  information  required  by  the  program  at  the  beginning  of  a 
forced  response  analysis.  More  than  one  second  job  [JOBS  (2)]  may  be 
run  using  the  re-start  tape  as  initial  input;  i.e.,  the  re-start 
tape  is  not  destroyed. 

Control  cards  and  deck  set-up  for  execution  on  the  CDC  6400 
computer  at  the  University  of  California,  Berkeley  are  given  below: 


A- 1 


JOB ( 1 ) - EIGENVALUE  SOLUTION/RE-START  TAPE  CREATION 
Notes  Card  Deck 

(1)  Job  number,  1,  200,  120000,300,  User  Name 

(2)  REQUEST,  TPl , I . Reel  No.,  Tape  User  Name 

(3)  CdPYBF,  TP1.SAP4 
UNLOAD, TPl 

(4)  LGtf,SAP4 

REWIND, TAPE1  ,TAPE2  , TAPE7 , TAPE8 , TAPE9 

(5)  REQUEST , RESTA RT , I . Reel  No.,  Tape  User  Name,  OUTPUT 
/CdPYBF.TAPEl , RESTART 

1 C0PYBF , TAPE2 , RESTA  RT 

(6)  / C()PYBF,TAPE7  , RESTART 
J C0PYBF, TAPE8  , RESTA  RT 
\ C dPYB  F , TA  PE  9 , RESTART 

(7)  7-8-9 

PROBLEM  DATA  DECK: 

I . HEADING  CARD 

II.  MASTER  CONTROL  CARD  with 
(LL.EQ.O) 

(NF.GE .1) 

(NDYN.EQ.l) 

(M0DEX.EQ.O) 

III.  JOINT  DATA 

IV.  ELEMENT  DATA 

V.  CONCENTRATED  MASS  DATA 

VI.  ELEMENT  LOAD  MULTIPLIERS 

VII.  DYNAMIC  ANALYSIS 
A.  Mode  Shapes  and  Frequencies 

blank  card 
blank  card 

(8)  6-7-8-9 


The  job  control  card  parameters  are  defined  as  follows: 

"l"  = Number  of  tape  drives  required  for  the  job. 

"200"  = CPU  time  limit  (in  octal  seconds)* 

"120000"  = Central  memory  field  length  (in  octal)  . 

"300"  = Page  limit  for  printing. 

Tape  containing  binary  version  of  program  (TPl)  is  requested. 
Binary  version  ot  the  program  is  copied  onto  a disk  file  (SAF4) , 
Program  is  loaded  and  execution  is  initiated. 

A blank  tape  (RESTART)  is  requested. 

The  contents  of  disk  files  TAPEl ,TAPE2 , etc.  are  copied  onto 
tape  RESTART. 

End-of-record  card:  7,8,9  punched  in  column  1, 

End-of-file  card:  6,7,8, 9 punched  in  column  1. 


NOTES/ 

(1) 


(2) 

(3) 

(4) 

(5) 

(6) 


(7) 

(8) 


A-2 


JOB  (2)  - RE-START  FOR  RESPONSE  HISTORY  ANALYSIS  (NDYN.EQ.-2) 

or  RESPONSE  SPECTRUM  ANALYSIS  (NDYN.EQ.-3) 


Notes  Card  Deck 

Job  number,  1,200,120000,300.  User  Name 

[REQUEST,  RESTART,  I.  Reel  No.  , User  Name 
C0PYBF,  RESTART, TAPEl 
C0PYBF, RESTART, TAPE2 
C0PYBF,  RESTART, TAPE7 
C0PYBF,  RESTART,  TAPE8 
C0PYBF, RESTART, TAPE 9 
REWIND, TAPEl ,TAPE2 ,TAPE7 , TAPE8 ,TAPE9 
UNL0AD,  RESTART 

REQUEST , TP1 , I . Reel  No.,  User  Name 
(2)  C0PYBF,  TP1 , SAP4 
LG0, SAP4 
7-8-9 

PROBLEM  DATA  DECK 

I.  HEADING  CARD 
II.  MASTER  CONTROL  CARD  with 
(LL.EQ.O) 

(NF.GE.l) 

(NDYN.EQ.-2  or  -3) 

(3)  (MODEX.EQ.O) 

VII.  DYNAMIC  ANALYSIS 

B.  Dynamic  Response  Analysis  (NDYN.EQ.-2) 

or 

C.  Response  Spectrum  Analysis  (NDYN.EQ.-3) 

blank  card 
blank  card 

6-7-8- 9 

NOTES/ 

(1)  The  disk  files  TAPEl, TAPE2  , etc.  are  re-created  using  the 
information  saved  on  tape  RESTORE. 

(2)  The  binary  version  of  the  program  is  again  obtained  from 
tape  TP1 . 

(3)  Normally,  the  number  of  frequencies  ("nf")  entered  on  the 
MASTER  CONTROL  CARD  for  a re-start  case  has  the  same  value 
as  was  specified  earlier  when  the  eigenvalue  problem  was 
solved ^ in  JOB(l) . If  a value  for  the  cut-off  frequency 
( COFQ  ) was  entered  on  the  Mode  Shapes  and  Frequencies'* 
control  card  [in  J0B(1)]  and  the  program  extracted  fewer 
than  "nf”  frequencies  (eigenvalues),  then  only  the  actual 
number  of  eigenvalues  computed  by  the  program  in  JOB(l) 
is  specified  for  "nf"  in  this  re-start  run. 


A- 3 


APPENDIX  B: 


CONTROL  CARDS  AND DECK  SET-UP  FOR  USE  OF  STARTING 


ITERATION  VECTORS 


In  the  dynamic  analysis  of  large-order  systems,  the  solution  of 
the  required  eigensystem  is  normally  the  most  expensive  phase.  The 
option  described  in  this  appendix  demonstrates  how  it  is  possible  to 
use  NF0  previously  calculated  eigenvalues  and  vectors  when  the  solu- 
tion for  NF  ^ NF0  eigenvalues  and  eigenvectors  is  required. 

Assume  that  in  Job(l),  the  solution  for  NF0  eigenvalues  and 
eigenvectors  was  performed.  At  the  end  of  this  job,  TAPE2  and  TAPE7 
must  have  been  saved  on  a physical  tape,  say  "RESTART".  Assuming  that 
in  JOB (2 ) the  solution  of  NF  eigenvalues  and  eigenvectors  is  required, 
then  prior  to  the  execution  of  this  job,  tape  RESTART  needs  to  be 
copied  onto  TAPE10. 

This  procedure  was  performed  with  the  following  control  cards 
on  the  CDC  6400  of  the  University  of  California  at  Berkeley: 


JOB (1)  - SOLUTION  FOR  NF0  EIGENVALUES/RESTART  TAPE  CREATION 
Notes  Card  Deck 


(1) 

(2) 

(3) 

(4) 


Job  No.,  1,200,120000,500.  User  Name 
REQUEST, TPl , I . Reel  No.,  Tape  User  Name 
C0PYBF.TP1 ,SAP4 
UNL0AD , TPl 
| REQUEST, TAPE2 ,NB 
( REQUEST, TAPE7.NB 
LG0.SAP4 

REWIND, TAPE2 ,TAPE7  _ ^ 

REQUEST, RESTART, I . Reel  No., Tape  User  Name,  OUTPUT 
f C0PYBR, TAPE2 , RESTART , 1 
\ C0PYBF.TAPE7 ,TP3 
7-8-9 

PROBLEM  DATA  DECK 
6-7-8-9 


Notes, 


(1)  See  Notes  (1)  - (4)  in  Appendix  A. 

(2)  The  computer  is  directed  to  write  on  disk  files  TAPE2 
and  TAPE7  in  an  unblocked  format. 

(3)  A blank  tape  (RESTART)  is  requested  onto  which  the  contents 
of  files  TAPE2  and  TAPE 7 are  to  be  written. 

(4)  The  contents  of  files  TAPE2  and  TAPE7  are  written  as  one  file 
onto  tape  RESTART. 


B-l 


JOB (2 ) - SOLUTION  FOR  ADDITIONAL  EIGENVALUES  USING  THE  INFORMATION 
STORED  ON  TAPE  "RESTART" 


Notes  Card  Deck 

Job  No. ,1,200,120000,500.  User  Name 

(1)  f REQUEST , RESTART , I . Reel  No.,  Tape  User  Name 
< REQUEST, TAPE 10, NB 

( REQUEST, TAPE2 ,NB 
REQUEST, TAPE7,NB 

(2)  C0PYBF, RESTART, TAPE 10 
UNLOAD , RESTART 

(REWIND,  TAPE10 

REQUEST, TPl , I . Reel  No.,  Tape  User  Name 
C0PYBF, TPl , SAP4 
LG0, SAP4 
7-8-9 

PROGRAM  DATA  DECK 
6-7-8-9 

Notes/ 

(1)  TAPE10  (as  TAPE2  and  TAPE7  if  they  are  to  be  used  for 

further  restarts,)  is  requested  to  be  an  unblocked  file. 

(2)  The  contents  of  tape  RESTART  are  copied  into  TAPE10  as 
one  file. 


(3)  Program  execution. 
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EARTHQUAKE  ENGINEERING  RESEARCH  CENTER  REPORTS 


EERC  67-1  "Feasibility  Study  Large-Scale  Earthquake  Simulator  Facility",  by 

J.  Penzien,  J.  G.  Bouwkamp,  R.  W.  Clough  and  D.  Rea  - 1967  (PB  187  905) 


EERC  68-1  Unassigned 

EERC  68-2  "Inelastic  Behavior  of  Beam-to-Column  Subassemblages  Under 

Repeated  Loading",  by  V.  V,  Bertero  - 1968  (PB  184  888) 

EERC  68-3  "A  Graphical  Method  for  Solving  the  Wave  Reflection-Refraction 
Problem",  by  H.  D.  McNiven  and  Y.  Mengi  - 1968  (PB  187  943) 

EERC  68-4  "Dynamic  Properties  of  McKinley  School  Buildings"/  by  D.  Rea, 

J.  G.  Bouwkamp  and  R.  W.  Clough  - 1968  (PB  187  902) 

EERC  68-5  "Characteristics  of  Rock  Motions  During  Earthquakes" , by  H • B.  Seed, 
I.  M.  Idriss  and  F.  W.  Kiefer  - 1968  (PB  188  338) 


EERC  69-1  "Earthquake  Engineering  Research  at  Berkeley"  - 1969  (PB  187  906) 

EERC  69-2  "Nonlinear  Seismic  Response  of  Earth  Structures",  by  M.  Dibaj  and 

J*  Penzien  - 1969  (PB  187  904) 

EERC  69-3  "Probabilistic  Study  of  the  Behavior  of  Structures  During  Earth- 

quakes", by  P.  Ruiz  and  J.  Penzien  - 1969  (PB  187  886) 

EERC  69-4  "Numerical  Solution  of  Boundary  Value  Problems  in  Structural 

Mechanics  by  Reduction  to  an  Initial  Value  Formulation",  by 
N.  Distefano  and  J,  Schujman  - 1969  (PB  187  942) 

EERC  69-5  "Dynamic  Programming  and  the  Solution  of  the  Biharmonic  Equation", 
by  N.  Distefano  - 1969  (PB  187  941) 

EERC  69-6  "Stochastic  Analysis  of  Offshore  Tower  Structures",  by  A,  K.  Malhotra 
and  J-  Penzien  - 1969  (PB  187  903) 

EERC  69-7  "Rock  Motion  Accelerograms  for  High  Magnitude  Earthquakes",  by 
H.  B.  Seed  and  I.  M.  Idriss  - 1969  (PB  187  940) 

EERC  69-8  "Structural  Dynamics  Testing  Facilities  at  the  University  of 

California,  Berkeley",  by  R.  M.  Stephen,  J.  G.  Bouwkamp,  R.  W. 

Clough  and  J.  Penzien  - 1969  (PB  189  111) 


Note:  Numbers  in  parentheses  are  Accession  Numbers  assigned  by  the  National  Technical 
Information  Service.  Copies  of  these  reports  may  be  ordered  from  the  National 
Technical  Information  Service,  Springfield,  Virginia,  22151.  Either  the  accession 
number  or  a complete  citation  should  be  quoted  on  orders  for  the  reports. 
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EE PC  69-9 


EERC  69-10 
EERC  69-11 
EERC  69-12 


'Seismic  Response  of  Soil  Deposits  Underlain  by  Sloping  Rock 
Boundaries  , by  H.  Dezfulian  and  H.  B.  Seed  - 1969  (PB  189  114) 


"Dynamic  Stress  Analysis  of 
Loading",  by  S.  Ghosh  and  E. 


Axisymmetric  Structures  Under  Arbitrary 
L.  Wilson  - 1969  (PB  189  026) 


"Seismic  Behavior  of  Multistory  Frames  Designed  by  Different 
Philosophies",  by  J.  C.  Anderson  and  V.  V.  Bertero  - 1969  (PB  190  662) 

"Stiffness  Degradation  of  Reinforcing  Concrete  Structures  Sub- 
jected to  Reversed  Actions",  by  V.  V.  Bertero,  B.  Bresler  and 
H.  Ming  Liao  - 1969  (PB  202  942) 


EERC  69-13  "Response  of  Non-Uniform  Soil  Deposits  to  Travel  Seismic  Waves" 
by  H.  Dezfulian  and  H.  B.  Seed  - 1969  (PB  191  023) 


EERC  69-14 


Damping  Capacity  of  a Model  Steel  Structure 11 , by  D. 
and  J.  G.  Bouwkamp  - 1969  (PB  190  663) 


Rea,  R.  W.  Clough 


EERC  69-15  "Influence  of  Local  Soil  Conditions  on  Building  Damage  Poten- 
tial During  Earthquakes",  by  H.  B.  Seed  and  I.  M.  Idriss  - 1969 
(PB  191  036) 


EERC  69-16  "The  Behavior  of  Sands  Under  Seismic  Loading  Conditions",  by 
M.  L.  Silver  and  H.  B.  Seed  - 1969  (AD  714  982) 


EERC  70-1 


"Earthquake  Response  of  Concrete  Gravity  Dams",  by  A.  K.  Choora 
1970  (AD  709  640)  P 


EERC  70-2 


"Relationships  Between  Soil  Conditions  and  Building  Damage  in 
the  Caracas  Earthquake  of  July  29,  1967",  by  H.  B.  Seed,  I.  M 
and  H.  Dezfulian  - 1970  (PB  195  762)  ' 


Idriss 


"Cyclic  Loading  of  Full  Size  Steel  Connections",  by  E.  P.  Podov 
and  R.  M.  Stephen  - 1970  (PB  213  545) 


EERC  70-4  "Seismic  Analysis  of  the  Charairra  Building,  Caraballeda,  Venezuela", 
by  Subcommittee  of  the  SEAONC  Research  Committee,  V.  V,  Bertero, 

f*  l'  tF,rf!eSSa'  S>  A‘  Mahin'  J-  H-  Sexton,  A.  C.  Scordelis , E.  L.  Wilson, 
L.  A.  Wyllie,  H.  B.  Seed,  and  J.  Penzien,  Chairman  - 1970  (PB  201  455) 

EERC  70-5  "A  Computer  Program  for  Earthquake  Analysis  of  Dams",  by  A.  K. 

Chopra  and  P.  Chakrabarti  - 1970  (AD  723  994) 


EERC  70-6 
EERC  70-7 


EERC  70-8 


"The  Propagation  of  Love  Waves  Across  Non-Horizontally  Layered 
Structures",  by  J.  Lysmer  and  L.  A.  Drake  - 1970  (PB  197  896) 

Influence  of  Base  Rock  Characteristics  on  Ground  Response", 
by  J.  Lysmer,  H.  B-  Seed  and  P.  B.  Schnabel  - 1970  (PB  197  897) 

"Applicability  of  Laboratory  Test  Procedures  for  Measuring  Soil 
Liquefaction  Characteristics  Under  Cyclic  Loading",  by  H.  B. 
Seed  and  W.  H.  Peacock  - 1970  (B  198  016) 
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EE PC  70-9 
EERC  70-10 

EEPC  71-1 
EERC  71-2 

EEPC  71-3 
EERC  71-4 
EERC  71-5 
EERC  71-6 

EERC  71-7 
EERC  71-8 

EERC  72-1 
EERC  72-2 
EERC  72-3 
EERC  72-4 
EERC  72-5 

EERC  72-6 
EERC  72-7 


"A  Simplified  Procedure  for  Evaluating  Soil  Liquefaction  Potential"/ 
by  H.  B.  Seed  and  I.  M.  Idriss  - 1970  (PB  198  009) 

"Soil  Moduli  and  Damping  Factors  for  Dynamic  Response  Analysis", 
by  H.  B.  Seed  and  I.  M.  Idriss  - 1970  (PB  197  869) 


"Koyna  Earthquake  and  the  Performance  of  Koyna  Dam",  by  A.  K. 

Chopra  and  P.  Chakrabarti  - 1971  (AD  731  496) 

"Preliminary  In-Situ  Measurements  of  Anelastic  Absorption  in  Soils 
Using  a Prototype  Earthquake  Simulator",  by  R.  D.  Borcherdt  and 
P.  W.  Rodgers  - 1971  (PB  201  454) 

"Static  and  Dynamic  Analysis  of  Inelastic  Frame  Structures  , by 
F.  L.  Porter  and  G.  H.  Powell  - 1971  (PB  210  135) 

"Research  Needs  in  Limit  Design  of  Reinforced  Concrete  Structures", 
by  V.  V.  Bertero  - 1971  (PB  202  943) 

"Dynamic  Behavior  of  a High-Rise  Diagonally  Braced  Steel  Building", 
by  D.  Rea,  A.  A.  Shah  and  J.  G.  Bouwkamp  - 1971  (PB  203  584) 

"Dynamic  Stress  Analysis  of  Porous  Elastic  Solids  Saturated  With 
Compressible  Fluids",  by  J.  Ghaboussi  and  E.  L.  Wilson  - 1971 
(PB  211  396) 

"Inelastic  Behavior  of  Steel  Beam-to-Column  Subasserrblages" , by 
H.  Krawinkler,  V.  V.  Bertero  and  E.  P.  Popov  - 1971  (PB  211  335) 

"Modification  of  Seismograph  Records  for  Effects  of  Local  Soil 
Conditions"  by  P.  Schnabel,  H.  B.  Seed  and  J.  Lysmer  - 1971 
(PB  214  450) 

"Static  and  Earthquake  Analysis  of  Three  Dimensional  Frame  and  Shear 
Wall  Buildings"  by  E.  L.  Wilson  and  H.  H.  Dovey  - 1972  (PB  212  589) 

"Accelerations  in  Rock  For  Earthquakes  in  the  Western  United  States", 
by  P.  B.  Schnabel  and  H.  B.  Seed  - 1972  (PB  213  100) 

"Elastic-Plastic  Earthquake  Response  of  Soil-Building  Systems 
by  T.  Minami  and  J.  Penzien  - 1972  (PB  214  868) 

"Stochastic  Inelastic  Response  of  Offshore  Towers  to  Strong 
Motion  Earthquakes",  by  M.  K.  Kaul  and  J.  Penzien  - 1972  (PB  215  713) 

Cyclic  Behavior  of  Three  Reinforced  Concrete  Flexural  Members 
With  High  Shear"  by  E.  P.  Popov,  V.  V.  Bertero  and  H.  Krawinkler  - 
1972  (PB  214  555) 

"Earthquake  Response  of  Gravity  Dams  Including  Reservoir  Interaction 
Effects"  by  P.  Chakrabarti  and  A.  K.  Chopra  - 1972. 

"Dynamic  Properties  of  Pine  Flat  Dam",  by  D.  Rea,  C.  Y.Liau  and 
A.  K.  Chopra  - 1972. 


4. 


EERC  72-8  "Three  Dimensional  Analysis  of  Building  Systems" , by  E.L.  Wilson 
and  H.H.  Dovey  - 1972, 

EERC  72-9  "Rate  of  Loading  Effects  on  Uncracked  and  Repaired  Reinforced 
Concrete  Members",  by  V.V.  Bertero,  D . Rea,  S.  Mahin  and 
M.  Atalay  - 1973 

EERC  72-10  "Computer  Program  for  Static  and  Dynamic  Analysis  of  Linear 

Structural  Systems",  by  E.L,  Wilson,  K.J.  Bathe,  J.E.  Peterson 
and  H.H.  Dovey  - 1972. 

EERC  72-11  "Literature  Survey  - Seismic  Effects  on  Highway  Bridges"  by  T. 
Iwasaki,  J.  Penzien  and  R.  Clough  - 1972  (PB  215  613) 


EERC  72-12  "SHAKE,  a Computer  Program  for  Earthquake  Response  Analysis  of 

Horizontally  Layered  Sites",  by  P.B.  Schnabel  and  J.  Lysmer  - 1972. 


EERC  73-1  "Optimal  Seismic  Design  of  Multistory  Frames",  by  V.V.  Bertero  and 
H.  Kamil  - 1973. 

EERC  73-2  "Analysis  of  the  Slides  in  the  San  Fernando  Dams  During  the 

Earthquake  of  February  9,  1971",  by  H.B.  Seed,  K.L.  Lee,  I.M.  Idriss 
and  F.  Makdisi  - 1973. 


EERC  73-3  "Computer  Aided  Ultimate  Load  Design  of  Unbraced  Multistory  Steel 
Frames",  by  M.B.  El-Hafez  and  G.J.  Powell  - 1973. 

EERC  73-4  "Experimental  Investigation  into  the  Seismic  Behavior  of  Critical 
Regions  of  Reinforced  Concrete  Components  as  Influenced  by  Moment 
and  Shear",  by  M.  Celebi  and  J.  Penzien  - 1973  (PB  215  884) 

EERC  73-5  "Hysteretic  Behavior  of  Epoxy-Repaired  Reinforced  Concrete  Beams", 
by  M.  Celebi  and  J.  Penzien  - 1973. 

EERC  73-6  "General  Purpose  Computer  Program  for  Inelastic  Dynamic  Response 
of  Plane  Structures",  by  A.  Kanaan  and  G.H.  Powell  - 1973. 

EERC  73-7  "A  Computer  Program  for  Earthquake  Analysis  of  Gravity  Dams  Including 
Reservoir  Interaction",  by  P.  Chakrabarti  and  A.K.  Chopra  - 1973. 


EERC  73-8  "Seismic  Behavior  of  Spandrel  Frames  — A Review  and  Outline  for 
Future  Research",  by  R.  Razani  and  J.G.  Bouwkamp  - 1973. 

^ - 

EERC  73-9  " Earthquake  Analysis  of  Structure-Foundation  Systems'*,  by  A.  K. 

Vaish  and  A.  K.  Chopra  - T973^  ' ' ~ 1 


EERC  73-10  "Deconvolution  of  Seismic  Response  for  Linear  Systems",  by 
R.  B.  Reimer  - 1973. 


EERC  73-11  "SAP  IV  Structure  Analysis  Program  for  Static  and  Dynamic  Response 
of  Linear  Systems",  by  K.  - J . Bathe,  E.  L.  Wilson,  and  F.  E. 
Peterson  - 1973  ( revised). 


5. 


GERC  73-12  "Analytical  Investigations  of  the  Seismic  Response  of  Tall 

Flexible  Highway  Bridges",  by  W.  S.  Tseng  and  J.  Penzien  - 1973. 

"Earthquake  Analysis  of  Multi-Story  Buildings  Including  Foundation 
. Tnrpraction".  by  A.  K.  Chopra  and  J.  A.  Gutierrez  - 1973  (PB  222  970) 


EERC  73-14  "ADAP  A Computer  Program  for  Static  and  Dynamic  Analysis  of  Arch 
Dams",  by  R.  W.  Clough,  J.  M.  Raphael  and  S.  Mojtahedi  - 1973 
(PB  223  763/AS). 

EERC  73-15  "Cyclic  Plastic  Analysis  of  Structural  Steel  Joints",  by 

R.  B.  Pinknpy  and  R.  W.  Clough  - 1973.  


EERC  73-16  "QUAD-4  A Computer  Program  for  Evaluating  the  Seismic  Response  of  j 
Soil  Structures  by  Variable  Damping  Finite  Element  Procedures" 
by  I.  M.  Idriss,  J.  Lysmer,  R.  Hwang  and  H.  G.  Seed  - 1973.  / 

EERC  73-17 "Dynamic  Behavior  of  a Multi-Story  FyramldShaped  Building  , 
by  R.  M.  Stephen  and  J.  G.  Bouwkamp  - 1973. 

EERC  73-18  "Effect  of  Different  Types  of  Reinforcing  on  Seismic  Behavior 
of  Short  Concrete  Columns",  by  V.  V.  Bertero,  J.  Hollings, 

0.  Kustu,  R.  M.  Stephen  and  J.  G.  Bouwkamp  - 1973. 

EERC  73-19  "Olive  View  Medical  Center  Material  Studies,  Phase  I",  by 
B.  Bresler  and  V.  Bertero  - 1973. 

EERC  73—20  "Linear  and  Nonlinear  Seismic  Analysis  Computer  Programs  for 
Long  Multiple— Span  Highway  Bridges",  by  W.  S.  Tseng  and 
J.  Penzien  - 1973. 

EERC  73-21  "Constitutive  Models  for  Cyclic  Plastic  Deformation  of  Engineering 
Materials",  by  J.  M.  Kelly  and  P.  P.  Gillis  - 1973. 

EERC  73-22  "DRAIN-2D  Users'  Guide"  by  G.  H.  Powell  - 1973. 

EERC  73-23  "Earthquake  Engineering  at  Berkeley  - 1973"  by  D.  Rea  - 1973. 

EERC  73-24  "Seismic  Input  and  Structural  Response  During  the  1971  San 
Fernando  Earthquake"  by  R.  B.  Reimer,  R.  W.  Clough,  and 
J ._  M . Raphael  - 1973 . , 

^EERC  73-25  "Earthquake  Response  of  Axisymmetric  Tower  Structures  Surrounded  j 
by  Water",  by  C.  Y.  Liaw  and  A.  K.  Chopra  - 1973. — 

EERC  73-26  "Investigation  of  the  Failures  of  the  Olive  View  Stairtowers 
During  the  San  Fernando  Earthquake  and  Their  Implications  on 
Seismic  Design",  by  V.  V.  Bertero  and  Robert  G.  Collins  - 1973. 

EERC  73—27  "Further  Studies  on  Seismic  Behavior  of  Steel  Beam— Column 

Subassemblages"  by  V.  V.  Bertero,  H.  Krawinkler  and  E.  P.  Popov  - 
1973. 


APPENDIX  E 


Parallel  FORTRAN  Listing  of  PV-SAP  Code 


o o o 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


c 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 

c 


c 

c 


Force  sap  of  NNP  ident  me 
Shared  integer  i ops  (8) , i opf  (8) 

**  AA  AA  A*  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  A 

SAPl* 

A STRUCTURAL  ANALYSIS  PROGRAM 
FOR  STATIC  AND  DYNAMIC  RESPONSE  OF  LINEAR  SYSTEMS 

K.J.  BATHE  , E.L.  WILSON  , F.E.  PETERSON 
UNIVERSITY  OF  CALIFORNIA  , BERKELEY 

IBM  CONVERSION  BY  UNIVERSITY  OF  SOUTHERN  CALIFORNIA 
AUGUST,  1973 
REVISED  JULY,  1 971* 

AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  AA  A 

IMPLICIT  REAL*8  (A-H.O-Z) 

Shared  REAL  T,TT 
Shared  REAL  TT 

Shared  COMMON  /JUNK/HED  (12) , JUK (1*06) 

Shared  COMMON  /ELPAR/NPAR  ( 1 4)  , NUMNP , MBAND .NELTYP ,N1 ,N2,N3.Nl*,N5, 

& mtot.neq 

Shared  COMMON  /EM/QQQ  (281*6) 

Shared  COMMON  /DYN/ I DU5  (1 D . NDYN 
Shared  COMMON  /TAPES/NQQ (6) 

Shared  COMMON  /EXTRA/M0DEX,NT8,N10SV,NT10,KEQB,NUMEL,T (10) 

Shared  COMMON  /SOL/NBLOCK , NEQB , LL , NF , I DUM, NE I G , NAD ,NVV, ANORM.NFO 
common  /maybe/  dxx  (50) , dyy  (50) , dzz  (50) , ee  (50) , aa (50) 

Shared  common  /say/neqq , numee , loopur ,nnblock,nterms, option 
Shared  common  /what/naxa (10000) , i rowl  (10000) , i col h (10000) 

PROGRAM  CAPACITY  CONTROLLED  BY  THE  FOLLOWING  TWO  STATEMENTS  ... 

Shared  COMMON  /one/A  (7500001) 

Shared  common  /time/  1 1 (8) , t2  (8) , t3  (8) 

Shared  integer  kdyn 
End  declarations 
MTOT=  7500000 
Barrier 

read  option  for  parallel  eqn  solver  if  option  is  1 then  solve 
sim.  eqns  by  parallel  subroutine  if  0 solve  it  by  original  sap 
read  (5.*) option 
End  barrier 


USE  THE  IBM  FORTRAN  EXTENDED  ERROR  HANDLING  FACILITY  TO 
ELIMINATE  PRINTOUT  OF  UNDERFLOW  ERROR  MESSAGE  (ERROR  NUMBER  208) 
C 

CAAA  CALL  ERRSET  (208,256.-1,1) 

C 

C 

C**A  CALL  ST  I ME 

C 

loopur=9 
nsf=l 3 


FILE:  PSAP  FRC  A OLD  DOMINION  UNIVERSITY 


NT8  * 8 
rewind  14 
REWIND  NT8 
NT  10=  10 
REWIND  NT  10 
N 1 = 1 

rewind  13 

5 zzzxg=0. 

C 

Barr i er 

C PROGRAM  CONTROL  DATA 
C 

C***  5 CALL  TT I ME  (T  ( 1 ) ) !5  IS  TRANSFERED  TO  THE  NEXE  LINE 

t (1 ) =second  () 

READ  (5, 100, END=990)  HED, NUMNP, NELTYP, LL.NF .NDYN.MODEX.NAD, 

1 KEQB.N10SV 

IF  (MODEX.GT.O)  MODEX  = 1 
IF  (NUMNP.EQ.O)  go  to  1999 

WRITE  (6,200)  HED , NUMNP, NELTYP, LL , NF , NDYN.MODEX.NAD, KEQB , N 1 OSV 

I F (KEQB.LT.2)  KEQB  = 99999 

IF  (NDYN.NE.O)  LL=1 

IF  (LL.GE.l)  GO  TO  10 

WRITE  (6,300) 

go  to  1999 

C***  DATA  PORTHOLE  SAVE 
10  I F (MODEX. EQ. 1) 

*WR I TE  (NT8)  HED, NUMNP, NELTYP, LL.NF.NOYN 
C 

KDYN  = I ABS  (NDYN)  +1 
IF  (KDYN.LE.5)  GO  TO  14 
WRITE  (6,310)  NDYN 
go  to  1999 
C 

C RE-START  MODE  ACTIVATED  IF  NDYN . EQ.-2  OR  NDYN.EQ.~3 
C 

14  IF  (NDYN.LT.O)  GO  TO  20 
C 

C INPUT  JOINT  DATA 
C 

N2=N1+6*NUMNP 

N3-N2+NUMNP 

N4=N3+NUMNP 

N5-N4+NUMNP 

N6-N5+NUMNP 

I F (N6.GT.MT0T)  CALL  ERROR  (N6-MT0T) 

C 

CALL  I NPUTJ  (A  (N 1)  ,A(N2)  ,A(N3)  ,A(N4)  ,A(N5)  , NUMNP, NEQ) 

C 

C FORM  ELEMENT  STIFFNESSES 
C 

C***  CALL  TTIME (T (2) ) 

t (2)  =second  () 


C 


MBAND-0 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


NUMEL=0 
REWIND  1 
REWIND  2 
C 

DO  900  M*1 , NELTYP 
READ  (5,1001)  NPAR 
C***  DATA  PORTHOLE  SAVE 

IF  (MODEX.EQ. 1)  WRITE  (NT8)  NPAR 
WRITE  (1)  NPAR 
NUMEL=NUMEL+NPAR  (2) 

MTYPE=NPAR  (1) 

C 

CALL  ELTYPE  (MTYPE) 

C 

900  CONTINUE 
neqq=neq 
numee=nume 1 
C 

C DETERMINE  BLOCKSIZE 

C 

C ADDSTF 

C 

NEQB*  (MTOT  - U*LL) / (MBAND  + LL  + l)/2 
C 

C OVER-RIDE  THE  SYSTEM  MATRIX  BLOCKSIZE  WITH  THE  INPUT  (NON-ZERO) 

C VALUE,  KEQB . 

C THIS  OVER-RIDE  ENTRY  IS  TO  ALLOW  PROGRAM  CHECKING  OF  MULT  I - 

C BLOCK  ALGORITHMS  WITH  WHAT  WOULD  NORMALLY  BE  ONE  BLOCK  DATA. 

C 

I F (KEQB.LT.NEQB)  NEQB  = KEQB 
C 

GOTO  (690,700,700,700,730),  KDYN 
C 

C STATIC  SOLUTION 

C 

690  CONTINUE 

N E QB 1 = (MTOT  - MBAND) / (2*  (MBAND+LL)  + 1) 

NEQB2*  (MTOT  - MBAND  - LL*  (MBAND-2) ) / (3*LL  + MBAND  + 1) 

IF  (NEQB1 .LT.NEQB)  NEQB=NEQB1 
IF  (NEQB2.LT. NEQB)  NEQB-NEQB2 
NBLOCK  - (NEQ-D/NEQB  +1 
IF  (NEQB.GT.NEQ)  NEQB-NEQ 
neqb*neq 
nblockH 
GO  TO  790 
C 

C E I GENSOLUT I ON 
C 

C 1.  DETERMINANT  SEARCH  ALGORITHM 

C 

700  IF  (NEQB. LT.NEQ)  GO  TO  710 
NIM-3 

NC=NF  + NIM 
NVM-6 

NCA=NEQ*MAXO  (MBAND, NC) 


o o o 
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NTOT=NCA  + 4*NEQ  + 2*NVM*NEQ  + 5*NC 
NE I G=0 

IF  (NTOT.LE.MTOT)  GO  TO  720 
C 

C 2.  SUBSPACE  ITERATION  ALGORITHM 

C 

710  NV-MINO  (2*NF,NF+8) 

IF  (NAD .NE .0)  NV-NAD 
NEQBMMTOT  - MBAND)  / (2*MBAND  + 1) 

NEQB2=  (MTOT  - MBAND  - 2*NV  - NV*  (MBAND-2) ) / (3*NV  + MBAND  + 1) 
NEQB3*  (MTOT  - 3*NV*NV  - 3*NV)  / (2*NV  + 1) 

NEQB1»-(MT0T  - 6*NV)/(1  + MBAND) 

IF  (NEQB1 . LT.NEQB)  NEQB=NEQB1 
IF  (NEQB2. LT.NEQB)  NEQB=NEQB2 
IF  (NEQB3- LT.NEQB)  NEQB-NEQB3 
IF  (NEQB4. LT.NEQB)  NEQB-NEQBA 
NE I G=1 
C 

720  CONTINUE 

NBLOCK  = (NEQ-D/NEQB  +1 
IF  (NEQB.GE.NEQ)  NEQB*NEQ 
C 

C HISTORY  OR  SPECTRUM  ANALYSIS 
C 

KREM  = 1000 

NTOT  = NBLOCK*NEQB*NF  + KREM 
IF  (MTOT. LT. NTOT) 

*WRITE  (6,320) 

GO  TO  790 
C 

C STEP-BY-STEP  DIRECT  INTEGRATION 

C 

730  CONTINUE 

C DISPLACEMENT  COMPONENTS  FOR  DIRECT  OUTPUT  (*NSD*) 

NN2  = NEQ 

C DISPLACEMENT  COMPONENTS  REQUIRED  FOR  RECOVERY  OF  ALL  OF  THE 
C REQUESTED  ELEMENT  STRESS  COMPONENTS  (*NSS*) 

NN3  = NEQ 
C 

C 1.  DECOMPOSITION 

C 

NEQB1  = (MT0T-NN2-NN3-NEQ-MBAND)/(2*MBAND+1) 

2.  TIME  INTEGRATION  PHASE 

NEQB2  - (MTOT-MBAND-2* (NN2+NN3) _5*NEQ) / (MBAND+1) 

C 

IF (NEQB1 .LT.NEQB)  NEQB  - NEQB1 
IF  (NEQB2.LT. NEQB)  NEQB  - NEQB2 
IF  (NEQB. GT. NEQ)  NEQB  - NEQ 
NBLOCK  = (NEQ-D/NEQB  +1 
C 

C 3.  INPUT  PHASE 

C 

C NUMBER  OF  TIME  FUNCTIONS  (*NFN*) 
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NN2  * 10 

C MAXIMUM  NUMBER  OF  FUNCTION  DEFINITION  POINTS  (*MXLP*) 
NN3  = 40 
C 

NN4  = 6*NUMNP  + 2*NN2*NEQ 
IF  (NN4.GT.MT0T) 

*WR I TE  (6,320) 

NN4  = NEQ*2*  (NN2+1)  + NN2*  ( 1+2*NN3) 

IF  (NN4.GT.MT0T) 

*WRITE  (6,320) 

C 

790  CONTINUE 

c 

c INPUT  NODAL  LOADS 

C 

N3*N2+NEQB*LL 

N4=N3+6>'tLL 

WRITE  (6,201)  NEQ, MBAND , NEQB, NBLOCK 
C 

C***  CALL  TTIME  (T(3)) 

t (3)  =second  () 


C 

c 

cl 

cl6 

C 

c*** 

c 

c 

c 


c 

c 

c 

c 


wr i te  (6 , *)  ' # neqb , 1 1 , n2 , n3 1 , neqb ,11, n2 , n3 
CALL  I NL  (A  (Nl)  , A (N2)  , A (N3)  , A (N4)  .NUMNP.NEQB,  LL) 
do  16  I=n2,n3 
wr  i te  (6,*)  '#  a (n2)  ' ,a  (1) 

CALL  TTIME  (T  (4) ) 
t (4)  =second  () 

FORM  TOTAL  STIFFNESS 

NE2B=2*NEQB 

N2“N1+NEQB*MBAND 

N3=N2+NEQB*LL 

N4=N3+4*LL 

NN2=N1+NE2B*MBAND 

NN3=NN2+NE2B*LL 

NN4=NN3+4*LL 

if  (option. eq.  1 .)  call  column 
nn2*nl+nterms 
nn3“nn2+neq*1 1 
nn4*nn3+4* 1 1 
ntr-nterms 


CALL  ADDSTF  (A  (Nl)  , A (NN2)  , A (NN3)  , A (NN4) .NUMEL .NBLOCK, NE2B, LL .MBAND 
1 , ANORM, NVV) 

if  (opt i on .eq . 1 .)  then 
nl*l 

nm2=nl+nterms 
nnn3=nn2+neq* 1 1 
i count*nm2 

do  126  i i *nn2 , nnn3- 1 
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a (icount)  =a  (i  i) 
i count=i count+1 
126  continue 

cal  1 assm(a  (nl)  ,a  (nm2)  , 1 1 ,nterms,neq) 
end  i f 

c write(6,*)'#  nn2,nn3‘ ,nn2,nn3 

c do  17  l*nl,ntr 

c 1 7 wr  i te  (6,  *)  '#  a (ntr)  ' , a (1 ) 

C 

C***  CALL  TTIME (T (5) ) 

t (5)  “second  () 

C 

C SOLUTION  PHASE 

C 

End  barrier 

20  GO  TO  (30,40,50,60,70),  KDYN 
C 

C STATIC  SOLUTION 

C 

30  I F (MODEX.EQ.O)  GO  TO  32 
DO  31  1*6,10 

31  T ( I ) * T (5) 

GO  TO  90 

C 

32  zzzx= 0. 

c 32  FORCECALL  SOLEQ 

Forcecal 1 SOLEQ 
C***  CALL  TTIME  (T  (6)) 

CCCCCCCVVVBBNM  the  following  barrier  bkock  is  transfered  fromm  the  end 
Barr i er 
TT  * 0.0 
DO  195  1=1,9 
T ( I ) = T (1  + 1)  -T  ( I ) 

TT  * TT  + T ( I ) 

195  CONTINUE 
C 

WRITE  (6,203)  (T  (K)  , K*1 ,9)  ,TT 
C 

End  barrier 
Joi  n 
Barr i er 
t (6)  “second  () 

DO  33  I “7, 10 
33  T ( I ) * T(6) 

GO  TO  90 
C 

C EIGENVALUE  EXTRACTION 
C 

End  barrier 
40  continue 

Barr i er 
T(6)  “ T(5) 

CALL  SOLEIG 

C***  CALL  TTIME  (T  (7)) 

t (7)  “second  () 
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T(8)  “ T (7) 

T (9)  = T (7) 

T ( i 0)  * T (7) 

GO  TO  90 
C 

C FORCED  DYNAMIC  RESPONSE  ANALYSIS 
C 

End  Barrier 
50  continue 

Barr i er 

T (6)  = T (5) 

I F (NDYN.LT.O)  GO  TO  52 
CALL  SOLEIG 

C***  CALL  TTIME  (T  (7) ) 

t (7)  =second  () 

GO  TO  51* 

52  DO  53  1=1.6 

53  T ( I + 1 ) “T  ( I ) 

REWIND  2 

READ  (2)  NEQ, NBLOCK, NEQB, MBAND, Nl, NF,  (QQQ(I) ,1  = 1, NF) 

REWIND  7 

IMAX=NEQB*NF 

READ  (7)  (A  (I)  , 1 = 1 ,NF) 

DO  56  L=1 , NBLOCK 
56  READ  (7)  (A  (I)  , 1=1 , IMAX) 

54  CALL  HISTRY 

C***  CALL  TTIME  (T  (8) ) 

t (8)  “second  () 

T(9)  = T (8) 

T (10)  = T (8) 

GO  TO  90 
C 

C RESPONSE  SPECTRUM  ANALYSIS 
C 

End  barrier 
60  continue 
Barr i er 
T (6)  = T (5) 

I F (NDYN.LT.O)  GO  TO  62 
CALL  SOLEIG 
t (7)  “second  () 

C***  CALL  TTIME  (T  (7) ) 

T (8)  = T(7) 

GO  TO  64 

62  DO  63  1=1,7 

63  T ( I + 1 ) =T ( I ) 

REWIND  2 

READ  (2)  NEQ.NBLOCK.NEQB.MBAND.Nl ,NF 

REWIND  7 

I MAX=NEQB*NF 

READ  (7)  (A  (I ) ,1  = 1, NF) 

DO  66  L=l, NBLOCK 
66  READ  (7)  (A  (I ) ,1  = 1,1  MAX) 

64  CALL  RESPEC 

C***  CALL  TTIME  (T  (9) ) 
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t (9)  “second  () 

T (10)  * T (9) 

GO  TO  90 
C 

C STEP-BY-STEP  (DIRECT  INTEGRATION)  ANALYSIS 
C 

End  barrier 

70  continue 
Barr i er 

DO  71  1=6,9 

71  T ( I ) - T(5) 

CALL  STEP 

C***  CALL  TT I ME  (T  (1 0) ) 

t (10)  “second  () 

C 

C COMPUTE  AND  PRINT  OVERALL  TIME  LOG 

C 

End  barrier 
90  continue 

Barr i er 
TT  = 0.0 
DO  95  1=1.9 
T { I ) = T (1+1)  -T  (I) 

TT  = TT  + T(l) 

95  CONTINUE 
C 

WRITE  (6,203)  (T(K)  ,K-1,9)  ,TT 
C 

End  barrier 
GO  TO  5 

c 990  continue 
c 1 999  continue 
C 

100  FORMAT  (1 2A6/9 1 5) 

200  FORMAT  ( 1 H 1 , 12A6/// 

1 38H  C 0 N T R 0 L I NFORMATI  ON,//  AX, 


2 

27H 

NUMBER  OF  NODAL  POINTS 

* 1 

15 

/ 

'♦x. 

3 

2 7 H 

NUMBER  OF  ELEMENT  TYPES 

” » 

15 

/ 

'♦X, 

k 

27H 

NUMBER  OF  LOAD  CASES 

f 

15 

/ 

**x. 

5 

27H 

NllMBER  OF  FREQUENCIES 

= * 

15 

/ 

4X, 

6 

27H 

ANALYSIS  CODE  (NDYN) 

* * 

15 

/ 

4X, 

7 

16H 

EQ.O,  STATIC, 

/ 

**X, 

8 

26h 

EQ.l,  MODAL  EXTRACTION 

, 

/ 

**x. 

9 

25H 

EQ.2,  FORCED  RESPONSE, 

/ 

‘♦x. 

A 

27H 

EQ. 3,  RESPONSE  SPECTRUM, 

/ 

4X, 

* 

28H 

EQ.1»,  DIRECT  INTEGRATION, 

/ 

4X, 

B 

27H 

SOLUTION  MODE  (MODEX) 

m t 

15 

/ 

4X, 

C 

19H 

EQ.O,  EXECUTION, 

/ 

4X, 

D 

20H 

EQ.l,  DATA  CHECK, 

/ 

4X, 

E 

19H 

NUMBER  OF  SUBSPACE, 

/ 

1*X, 

F 

27H 

ITERATION  VECTORS  (NAD) 

= t 

15 

/ 

**x. 

G 

27H 

EQUATIONS  PER  BLOCK 

= , 

15 

/ 

'♦x. 

H 

27H 

TAPE  10  SAVE  FLAG  (N10SV) 

* * 

15 

/ 

4X) 

201  FORMAT  (38H1E  QUATION  PARAMETERS,// 
* 3**H  TOTAL  NUMBER  OF  EQUATIONS  =,15, 
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C 


1 /3LH  BANDWIDTH 

2 /34H  NUMBER  OF  EQUATIONS  IN 

3 /34H  NUMBER  OF  BLOCKS 

203  FORMAT  (1H1.31H0  V E R A L L T I 

1 5X.30HN0DAL  POINT  INPUT 

2 5X.30HELEMENT  STIFFNESS  FORMATION 

3 5X.30HN0DAL  LOAD  INPUT 

4 5X.30HT0TAL  STIFFNESS  FORMATION 

5 5X.30HSTATIC  ANALYSIS 

6 5X , 30HE I GENVALUE  EXTRACTION 

7 5X. 30HF0RCED  RESPONSE  ANALYSIS 

8 5X , 30HRESP0NSE  SPECTRUM  ANALYSIS 
* 5X , 30HSTEP-BY-STEP  INTEGRATION 

9 5X , 30HT0TAL  SOLUTION  TIME 


*.15, 


A BLOCK  = 

= ,15, 

= 

= ,15) 

M E 

LOG, 

s 

F8 . 2 

/ 

= , 

F8 . 2 

/ 

= f 

F8.2 

/ 

= , 

F8 . 2 

/ 

= , 

F8. 2 

/ 

= , 

F8.2 

/ 

= f 

F8.2 

/ 

= f 

F8.2 

/ 

= , 

F8.2 

// 

= , 

F8.2 

/) 

300  FORMAT  (//  48H  **  ERROR.  (AT  LEAST  ONE  LOAD  CASE  IS  REQUIRED) 

310  FORMAT  (//  33H  **  ERROR.  ANALYSIS  CODE  (NDYN  = » 1 3 » 9H)  IS  BAD. 

320  FORMAT  (//  47H  **  WARNING.  ESTIMATE  OF  STORAGE  FOR  A DYNAMIC, 

1 32H  ANALYSIS  EXCEEDS  AVAILABLE  CORE,  //  IX) 


C 

1001  FORMAT  (1415) 
c End  barrier 

990  conti nue 

1999  continue 

c Join 

END 

SUBROUTINE  CALBAN  (MBAND , ND ! F , LM, XM, S , P , ND , NDM, NS) 
c IMPLICIT  REAL*8  (A-H.o-Z) 

C 

C CALLED  BY?  RUSS .TEAM, PLNAX , BR I CK8 , TPLATE , CLAMP, ELST3D , P I PEK 

C 

c CALCULATES  BAND  WIDTH  AND  WRITES  STIFFNESS  MATRIX  ON  TAPE  2 

DIMENSION  LM  (1)  ,XM(1)  , S (NDM,  NDM)  ,P(NDM,4) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL (14) 

common  /say/  neqq , numee, 1 oopur , nnb 1 ock , nterms ,opt i on 
common  /what/  naxa  (10000) , i rowl  (10000) , i col h (10000) 
c wr i te  (6 , *) 1 sub  calban  starts' 


neq=neqq 
nume=numee 
M I N= 100000 
MAX=0 

DO  800  L-l.ND 

IF  (LM (L) . EQ.O)  GO  TO  800 

IF  (LM  (L)  .GT.MAX)  MAX-LM  (L) 

IF  (LM  (L)  .LT.MIN)  MIN-LM(L) 

800  CONTINUE 

NDIF-MAX-MIN+1 

IF  (ND I F .GT.MBAND)  MBAND-NDIF 
IF (MODEX.EQ.l)  GO  TO  810 

LRD=ND*  (ND+1) /2+5*ND 

WRITE  (2)  LRD.ND, (LM (I) , 1-1 ,ND) , ( (S  (I ,J) ,J-I ,ND) ,1*1, ND) , 
1 ( CP  (I  . J)  ,1-1  .ND)  , J=1  ,4)  , (XM  ( I ) , I *1 , ND) 
wr i te (14) 1 rd,nd,  ( 1 m ( i ) , i * 1 , nd) 
rewind  13 


) 

) 


c 
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wr  i te  ( 1 3)  ( (s  ( i , j ) , j = 1 , nd)  , i * 1 , nd) 
c moayyad 

c write  (6,*)'  sub.  calban 1 

c wr  i te(6,*)  ' lrd.nd,  (lm(i)  , i-l  ,nd)  , ( (s  (i , j)  ,j-l  (=i)  ,nd)  , i = l,nd)  ' 

c wr  i te(6,*)  1 ( (p(i  , j)  , i-l  ,nd)  , j = l ,k)  , (xm(i)  , i = l ,nd)  ' 

c write  (6,*)'  Ird  nd'.lrd.nd 

C write  (6,*)  1 ===»===:=*:sss==e:===**  1 

c wr  i te  (6,  115)  ( (s  (i  , j)  , j«l  ,nd)  , i-l  ,nd) 

c wr  t te  (6 , ft)  1 ******=***p====== 1 

c wr  i te  (6,  1 15)  ( (p  (i  , j)  , i = l , nd)  , j = l ,4) 

c wr i te  (6 , ft)  1 ' 

c wr  i te  (6 , 1 15)  (xm  (i ) , i = 1 , nd) 

c write  (6,*)  1 =====*=====*»**==== 1 

1 15  format  (6el2 .5) 

c wr i te  (6, ft)  1 sub  calban  ends' 

*****************  ********************************************yyyyyyyyyyy 

c initialize  all  row  length  (include  the  diagonal) 

c do  1 i -1 , neq 

cl  i rowl ( i ) =0 

c do  2 i=l, nume 

maxdof=0 
do  3 j 1=1 , nd 
j j 1 ■ 1 m ( j 1 ) 

i f (j  j 1 .gt  .maxdof)  maxdof=j  j 1 

3 continue 

c find  the  current  row  length  and  update  the  row  length 

do  4 j 1*1 , nd 
j j 1 * 1 m ( j 1 ) 

if  ( j j 1 • eq • 0)  go  to  4 
nowr 1 =maxdof -j j 1+1 

i f (nowr  1 .gt . i rowl  (j  j 1) ) i rowl  (j  j 1)  «nowr  1 
c wr i te  (6,*)  ' j j 1 irowl  nd  nume ... ca 1 b ' ,jj 1 , i rowl  (jj 1 ), nd , nume 

4 continue 

c2  continue 

cnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn 

RETURN 

C 

810  WRITE  (1)  ND.NS,  (LM  ( I ) ,1  = 1 , ND) 

RETURN 

END 

****************************************** **** ************************** 
SUBROUTINE  ELTYPE  (MTYPE) 

C 

c IMPLICIT  REAL*8(A-H,0-Z) 

C 

C CALLED  BY?  MAIN, STRESS 

C 

c common  /maybe/  dxx  (50)  , dyy  (50)  , dzz  (50)  , ee  (50)  , aa  (50) 

common  /say/  neqq,numee, loopur , nnbl ock , nterms ,opt ion 
common  /what/  naxa  (10000) , i rowl  (10000) , icolh  (10000) 

GO  TO  (1,2,3,4,5,6,7,8,9,10,11,12) ,MTYPE 
C 

C THREE  DIMENSIONAL  TRUSS  ELEMENTS 

C 

c write  (6, *)'  sub  eltype  begins1 
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1 CALL  TRUSS 
GO  TO  900 

C 

C THREE  DIMENSIONAL  BEAM  ELEMENTS 
C 

2 CALL  BEAM 
GO  TO  900 

C 

C PLANE  STRESS  ELEMENTS 

C 

3 CALL  PLANE 
GO  TO  900 

C 

C AX  I SYMMETRIC  SOLID  ELEMENTS 

C 

L CALL  PLANE 
GO  TO  900 
C 

c THREE  DIMENSIONAL  SOLID  ELEMENTS 

C 

5 CALL  THREED 
GO  TO  900 

C 

C PLATE  BENDING  ELEMENTS 

C 

6 CALL  SHELL 
GO  TO  900 

C 

c 

7 CALL  BOUND 
GO  TO  900 

C 

C THICK  SHELL  ELEMENTS 

C 

8 CALL  S0L21 
GO  TO  900 

C 

9 WRITE  (6,100)  MTYPE 
GO  TO  900 

C 

10  WRITE  (6, 100)  MTYPE 
GO  TO  900 

C 

11  WRITE  (6,100)  MTYPE 
GO  TO  900 

C 

C STRAIGHT  OR  CURVED  PIPE  ELEMENTS 
C 

12  CALL  PIPE 
C 

c900  write  (6,*)'  sub.  eltype  ends' 

900  RETURN 
C 

100  FORMAT  ( 1 OELEMENT ' , I 4, 1 IS  NOT  IMPLEMENTED  YET') 
END 
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********************************************************************* 
SUBROUTINE  INL  ( I D , B ,TR, TMASS , NUMNP , NEQB, LL) 

C 

c IMPLICIT  REAL*8(A-H,0-Z) 

C 

C CALLED  BY?  MAIN 

C 

C INPUT  NODAL  LOADS  AND  MASSES 

C 

DIMENSION  ID  (NUMNP,  6)  ,B  (NEQB,  LL)  ,TR(6,LL)  ,TMASS  (NEQB) 

COMMON  / JUNK  / R (6)  ,TXM  (6)  , I F I LL  1 (A06) 

COMMON  /EXTRA/  MODEX , NT8 , I F I LL2  (1 4) 

C 

c write  (6,*)'  sub  ini  begins1 

NT=3 

REWIND  NT 
KSHF=0 

WRITE  (6,2002) 

I F (MODEX.EQ. 1)  GO  TO  50 
DO  750  1=1, NEQB 
TMASS ( I ) =0 . 

DO  750  K= 1 , LL 
750  B (I  ,K)«0.0 
C 

50  DO  900  NN=1, NUMNP 
C 

DO  100  1=1,6 
TXM(I)  =0. 

DO  100  J=1 , LL 
100  TR  (I , J) *0.0 
C 

I F (NN.EQ. 1)  GO  TO  300 
150  IF  (N.NE.NN)  GO  TO  400 
DO  200  1=1 ,6 
IF  (L)  180,180,190 
180  TXM  ( I ) =R  ( I ) 

GO  TO  200 
190  TR  (I  , L)  =R  (I ) 

200  CONTINUE 
300  READ  (5, 1001)  N , L , R 
IF  (N.EQ.O)  GO  TO  1 50 
WRITE (6,2001)  N,  L , R 
GO  TO  150 
C 

400  I F (MODEX.EQ. 1)  GO  TO  900 
DO  800  J-1,6 
I l = ID  (NN.J)-KSHF 
IF  (II)  800,800,500 
500  DO  600  K-l.LL 
600  B ( I I , K)  =TR  (J , K) 

TMASS  (I  I ) =TXM  (J) 

610  IF  (I  I .NE .NEQB)  GO  TO  800 
c wr i te  (6, *)  ' nt 1 , nt 

WRITE  (NT)  B, TMASS 
rewind  13 


c 


o o o o o 
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c write(13)  b, tmass 

c do  29  n=l, neqb 

c29  write(6,*)'  load  b' , (b  (n,m)  ,m=1 , 1 1) 

KSHF=KSHF+NEQB 
DO  700  1=1 ,NEQB 
TMASS ( I ) =0 . 

DO  700  K=1 , LL 
700  B (I  ,K)  =0.0 
800  CONTINUE 
900  CONTINUE 
C 

I F (MODEX.EQ. 1)  RETURN 
C 

WRITE  (NT)  B.TMASS 
c wr  i te  (1 3)  b,  tmass 

c do  19  i=l.neqb 

cl9  write  (6,*)'  load  b ' , (b  (i  , j)  , j = l , 1 1) 

C 

c write(6,*)‘  sub  ini  ends' 

RETURN 

1001  FORMAT  (2  1 5. 7F 10 .4) 

2001  FORMAT  (2  (3* . 1 4)  , 6 E 1 5 * 5) 

2002  FORMAT  (47H1N  ODAL  LOADS  (STATIC)  OR 

A 29HM  ASSES  (DYNAMIC),/// 

B 3X,4HNODE,3X,4HLOAD, 

1 2 (9X.6HX-AXI S.9X.6HY-AXI S.9X.6HZ-AXI S) , / 7H  NUMBER, 3X , 4HCASE , 

2 3(10X,5HFORCE)  , 3(9X,6HMOMENT)  , / IX) 

END 

******************************************************************** 
SUBROUTINE  INPUTJ  (ID,X,Y,Z,T, NUMNP , NEQ) 

C 

c IMPLICIT  REAL*8  (A-H.O-Z) 

c 

C CALLED  BY?  MAIN 

C 

DIMENSION  X(l)  ,Y(1)  ,Z  (1)  , I D (NUMNP,  6)  ,T(1) 

C 

COMMON  /EXTRA/  MOD  EX ,NT8, IF  I LL  (14) 

C 

C SPECIAL  NODE  CARD  FLAGS 

C - . 

C IT  COORDINATE  SYSTEM  TYPE  (CC  1,  ANY  NODE  CARD) 

C EQ.C,  CYLINDRICAL 

IPR  = PRINT  SUPPRESSION  FLAG  (CC  6,  CARD  FOR  NODE  1 ONLY) 
EQ.  , NORMAL  PRINTING 

EQ.A,  SUPPRESS  SECOND  PRINTING  OF  NODAL  ARRAY  DATA 
EQ.B,  SUPPRESS  PRINTING  OF  ID-ARRAY 
EQ.C,  BOTH  *A*  AND  *B* 

C 

DIMENSION  I PRC  (4) 

C 

DATA  I PRC/ 1 H , 1HA, 1HB, 1HC/ 

C 

c write  (6,*)'  sub.  inputj  begins....1 

IPR  = IPRC(l) 
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RAD  = ATAN(1  .ODO)  A5.0DO 
C 

c 

C READ  OR  GENERATE  NODAL  POINT  DATA 

WRITE  (6,2000) 

WRITE  (6,2001) 

N0LD=O 

10  READ  (5,1000)  IT,  N,  JPR,  ( I D (N , I)  ,1=1,6)  ,X(N)  ,Y(N)  ,Z(N)  ,KN,T(N) 

WRITE  (6,2002)  I T, N , JPR , ( I D (N , I ) , I =1 , 6)  , X (N)  , Y (N)  , Z (N)  , KN ,T  (N) 

IF  (N.EQ.l)  IPR  * JPR 
IF  ( I T . NE . I PRC  (k) ) GO  TO  15 
DUM  = Z (N) * RAD 
Z (N)  * X(N)*COS(DUM) 

X (N)  = X (N)  *SIN  (DUM) 

15  CONTINUE 

I F (NOLD.EQ.O)  GO  TO  50 

C CHECK  IF  GENERATION  IS  REQUIRED 

DO  20  1*1,6 

I F ( I D (N , I ) .EQ.O.AND. ID  (NOLD, I)  .LT.O)  I D (N , I ) -I D (NOLD , I ) 

20  CONTINUE 

I F (KN.EQ.O)  GO  TO  50 
NUM*  (N-NOLD) /KN 
NUMN*NUM- 1 

I F (NUMN.LT. 1)  GO  TO  50 
XNUM-NUM 

DX=  (X  (N)  -X  (NOLD) ) /XNUM 
DY*  (Y(N)-Y  (NOLD)) /XNUM 
DZ=(Z(N)-Z  (NOLD)) /XNUM 
DT*  (T  (N)-T  (NOLD)) /XNUM 
K=NOLD 

DO  30  J=1 , NUMN 

KK=K 

K*K+KN 

X (K)  =X  (KK)  +DX 
Y (K)  *Y  (KK)  +DY 
Z (K)  =Z  (KK)  +DZ 
T (K)  =T  (KK)  +DT 
DO  30  1-1,6 
ID  (K,  l)*ID  (KK,  I) 

IF  ( I 0 (K , I ) . GT. 1)  I D (K,  I ) = I D (KK, I ) +KN 
30  CONTINUE 
C 

50  NOLD-N 

I F (N.NE.NUMNP)  GO  TO  10 
C 

C PRINT  ALL  NODAL  POINT  DATA-— 

C 

IF  (I PR.EQ. I PRC  (2)  .OR.  I PR.EQ. I PRC  (A) ) GO  TO  52 
WRITE  (6,2003) 

WRITE  (6,2001) 

WRITE  (6,2005)  (N,  (ID  (N,  I)  , 1*1 ,6)  ,X  (N)  ,Y(N)  ,Z(N)  ,T(N)  ,N-1  ,NUMNP) 

52  CONTINUE 
C 

C NUMBER  UNKNOWNS  AND  SET  MASTER  NODES  NEGATIVE - - 

C 
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NEQ=0 

DO  60  N=1 ,NUMNP 

DO  60  1=1,6 

I D (N , I ) = I ABS  ( I D (N , I ) ) 

IF  (ID(N.I)-l)  57.58,59 

57  NEQ=NEQ+1 

ID  (N, I ) =NEQ 
GO  TO  60 

58  I D (N , I ) =0 

GO  TO  60 

59  ID  (N,  I)  — ID  (N,  I) 

60  CONTINUE 
C 

c print  MASTER  INDEX  ARRAY 

c 

I F (I  PR.EQ.  I PRC  (3)  .OR.  I PR . EQ.  I PRC  (4) ) GO  TO  62 
WRITE  (6,2001*)  (N,  (ID  (N,  I)  , 1=1 ,6)  ,N=1  ,NUMNP) 

62  CONTINUE 

I F (MODEX.EQ.O)  GO  TO  70 
C***  DATA  PORTHOLE  SAVE 

WRITE  (NT8)  ((I  D (N,  I)  , 1=1  ,6)  ,N=1  ,NUMNP) 

WRITE  (NT8)  (X(N)  ,N=1,NUMNP) 

WRITE  (NT8)  (Y(N)  ,N=1  .NUMNP) 

WRITE  (NT8)  (Z(N)  ,N=1, NUMNP) 

WRITE  (NT8)  (T(N)  ,N=1, NUMNP) 

ENDFILE  NT8 
C 

REWIND  2 
WRITE  (2)  ID 
C 

RETURN 

C 

70  CONTINUE 
REWIND  8 
WRITE  (8)  ID 
C 

RETURN 

C 

1000  FORMAT  (2 (A1 , I 4)  ,5 1 5. 3F 10 .0, I 5 » F 10 .0) 

2000  FORMAT  (//23H  NODAL  POINT  INPUT  DATA  ) 

2001  FORMAT  (5H0N0DE  3 X 24HB0UNDARY  CONDITION  CODES  11X, 

23HN0DAL  POINT  COORDINATES  / 7H  NUMBER  2X  1HX  4X  1HY  4X  1HZ  3X, 
! 2HXX  3X  2HYY  3X  2HZZ12X  1HX  1 2X  1HY  12X  1HZ  12X  1HT  ) 

2002  FORMAT  (1 X , A 1 , I 4, A 1 , I 3 . 5 1 5. 3F 1 3 • 3. 1 5. F 1 3- 3) 

2003  FORMAT  (//21H1GENERATED  NODAL  DATA) 

2004  FORMAT  (// 1 7H 1 EQUAT I ON  NUMBERS/ 

1 35H  N X Y Z XX  YY  ZZ  / (7 1 5) ) 

2005  FORMAT  (I5.6I5.4F13.3) 

END 

**************************************************************** 
SUBROUTINE  RUSS  ( I D , X ,Y , Z ,T, E .THERM, DEN, AREA, WT , NUMNP) 
c IMPLICIT  REAL*8(A-H,0-Z) 

C 

C CALLS?  CALBAN 

C CALLED  BY?  TRUSS 
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C 

C 

DIMENSION  X (1)  ,Y  (1)  ,2  (1)  , ID  (NUMNP , 1)  ,E  (1)  .THERM  (1)  , DEN  ( 1 ) .AREA  (1) 

• ,T  (1)  ,WT  (1) 

COMMON  /ELPAR/  NPAR  (14)  , NNNNN.MBAND.NELTYP.Nl , N2,N3,N4,N5,MTOT,NEQ 
COMMON  /EM/LM  (24)  . ND , NS . S (24 . 24)  , P (24,4)  ,XM(24)  ,ST(12,24)  ,TT(12,4) 

1 , I F I LL2  (3048) 

COMMON  /JUNK/  EMUL (4,4)  , I , J.K.L.M.N, I I , J J , KK .MTYPE .TEMP , DX , DY , DZ , 

1 XL2,XL,XX,YY,F,FT,FX,FY,FZ,MIN, MAX , ND I F , KKK .TEM.MTYP , I F I LL 1 (355) 
COMMON  /EXTRA/  M0DEX.NT8, I F I LL3  (14) 
c common  /maybe/  dxx  (50) , dyy  (50) , dzz  (50) , ee  (50) , aa (50) 

common  /say/  neqq.numee, loopur , nnb 1 ock , nterms , option 
common  /what/  naxa  (1 0000) , i rowl  ( 1 0000) , i col h (10000) 

C 

C CONTROL  INFORMATION  AND  MEMBER  PROPERTIES 
C 

c write(6,*)'  sub  russ  begins1 

NUME-NPAR (2) 

NUMMAT-NPAR (3) 

neqq=neq 

numee=nume 

WRITE  (6,2000)  NUME , NUMMAT 
WRITE  (6,2001) 

DO  10  1=1, NUMMAT 

READ  (5,1001)  N,E(N)  .THERM  (N)  , DEN  (N)  .AREA  (N)  ,WT(N) 

10  WRITE  (6,2002)  N, E (N)  .THERM  (N)  , DEN  (N) .AREA (N) ,WT (N) 

C***  DATA  PORTHOLE  SAVE 
IF (MODEX.EQ. 1) 

*WRITE  (NT8)  (E  (N)  .THERM  (N)  , DEN  (N)  , AREA  (N)  , WT  (N)  , N=1 , NUMMAT) 

C 

C ELEMENT  LOAD  MULTIPLIERS 
C 

READ  (5,1003)  EMUL 
WRITE  (6,2003)  EMUL 
C*A*  DATA  PORTHOLE  SAVE 
I F (MODEX.EQ. 1) 

AWRITE  (NT8)  EMUL 
C 

C ELEMENT  INFORMATION 
WRITE  (6,2005) 

C 

N=  1 

100  READ  (5.1004)  M, I I , JJ , MTYP.TEM, KK 
IF(KK.EQ.O)  KK=1 
120  IF  (M.NE.N)  GO  TO  200 
1=1  I 
J=JJ 

MTYPE=MTYP 

REFT-TEM 

KKK-KK 

C 

C 1.  FORM  ELEMENT  STIFFNESS  AND  STRESS  MATRICES 
C 

200  CONTINUE 

I F (MODEX.EQ. 1)  GO  TO  380 
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DX=X (I) -X  (J) 

DY-Y  (I)  -Y  (J) 

DZ-Z(I)-Z(J) 
c dxx  (m)  =dx 

c dyy  (m)  -dy 

c d 22  (m)  =dz 

XL2=DX*DX+DY*DY+DZ*DZ 
XL-SQRT  (XL2) 

XX=E  (MTYPE) *ARE A (MTYPE) *XL 
c ee  (m)  =e  (mtype) 

c aa  (m) -area  (mtype) 

ST  (1 , 1) =DX/XL2 
ST  ( 1 , 2) -DY/XL2 
ST  ( 1 , 3) =DZ/XL2 
ST (1 ,4) =-ST  (1,1) 

ST  (1,5) —ST  (1,2) 

ST  (1 ,6)  =-ST  (1 , 3) 

C 

DO  300  L-1,6 
YY-ST  (1 , L)  *XX 
DO  250  K-L.6 
S (K,L)=ST(1  ,K)*YY 
250  S (L , K)  =S  (K , L) 

ST  (1 , L)  =E  (MTYPE)  *ST  (1  , L) 

300  ST  (2 , L)  -AREA  (MTYPE)  *ST  (1 , L) 

C 

C 2.  INERTIA  AND  THERMAL  LOADS 
C 

F-WT  (MTYPE)  *AREA  (MTYPE)  *XL/2  . 

TEMP=  (T  ( I ) +T  ( J) ) *0 . 5 " REFT 
FT=TEMP*THERM  (MTYPE)  *E (MTYPE) *AREA (MTYPE) 

FT  * -FT 
FX=DX*FT/XL 
FY=DY*FT/XL 
F Z=DZ*FT/XL 
C 

DO  350  L-1,4 
TT  (2 , L)  -EMUL  (L , 4) *FT 
TT  (1  , L)  -TT  (2 , L)  / AREA  (MTYPE) 
P(1,L)=EMUL(L,1)*F-EMUL(L,4)*FX 
P (2 , L) -EMUL  (L.2) *F~EMUL  (L,4) *FY 
P (3 , L)  =EMUL  (L.  3)  *F-EMUL  (L,4)*FZ 
P (i» , L)  -EMUL  (L , 1 ) *F+EMUL  (L  ,4)  *FX 
P (5 , L)  -EMUL  (L , 2)  *F+EMUL  (L , 4)  *FY 
350  P (6, L) -EMUL  (L, 3) *F+EMUL (L , 4) *FZ 
F-DEN (MTYPE) *AREA  (MTYPE) *XL/2 . 

DO  375  L— 1*6 
375  XM  (L)  -F 
380  CONTINUE 
C 

C 3.  FORM  LOCATION  MATRIX  AND  COMPUTE  BAND  WIDTH 
C 

DO  400  L-1 ,3 
LM(L)-ID  (I  . L) 

400  LM(L+3)=ID(J,L) 
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C 

ND=6 

NS=2 

NDM-24 

CALL  CALBAN  (MBAND , ND I F , LM, XM, S , P , ND , NDM, NS) 

IF  (MODEX.EQ.O)  GO  TO  410 
C***  DATA  PORTHOLE  SAVE 

WRITE  (NT8)  N , I , J , MTYPE , REFT 
GO  TO  420 
410  CONTINUE 

WRITE  (1)  ND , NS , (LM  (L)  , L=1 , ND)  , ( (ST  (L , K)  , L=1 , NS)  , K=  1 ,ND)  , 

1 ( (TT  (L , K)  , L=  1 , NS)  , K=1 , 4) 
c write  (6,*)'%  nd,ns',nd,ns 

c do  88  1 *1 , ns 

c88  write  (6, 87)'  st' , (st  (1  ,k)  ,k=l  ,nd) 

c87  format  (6f 10.1) 

C 

C 4.  CHECK  FOR  MORE  ELEMENTS 
C 

420  CONTINUE 

WRITE  (6,2004)  N, I ,J, MTYPE, REFT, NDI F 

IF  (N . EQ.NUME)  RETURN 

N-N+l 

I = I +KKK 

J-J+KKK 

I F (N.GT.M)  GO  TO  100 
GO  TO  120 
C 

1001  FORMAT  (I 5>5F 10.0) 

1003  FORMAT  (4 F 10.0) 

1004  FORMAT  (4  I 5 , 1F10.0, 15) 

2000  FORMAT  (///25H 1 NUMBER  OF  TRUSS  MEMBERS®  15/ 

1 25H  NUMBER  OF  DIFF.  MEMBERS®  15) 

2001  FORMAT  (///IX, 4HTYPE , 1 4X , 1 HE , 1 OX , 5H ALPHA , 1 2X, 3HDEN, 1 1 X , 4HARE A 
1 11X.4H  WT  ) 

2002  FORMAT  (I5.5E15-7) 

2003  FORMAT  (///25H  ELEMENT  LOAD  MULTIPLIERS  / 20X, 1 H A , 1 4X , 1HB, 14X, 1HC, 

1 14X.1HD./6H  X-DIR4E15-6/  6H  Y-D I R4E 15-6/  6H  Z-DIR4E15.6/ 

2 6H  TEMP4E15-6) 

2004  FORMAT  (4 1 6, F 10 . 2 , I 7) 

2005  FORMAT  (///42H1  N I J TYPE  TEMP  BAND  ) 

END 

*************A****A****^AA***/r/cA*AA*iVft***yir****/cAAA******AAyti«r***AA*A 
Forcesub  SOLEQ  of  NNP  ident  ME 
c SUBROUTINE  SOLEQ 

c IMPLICIT  REAL*8(A-H,0-Z) 

C 

C CALLS?  SESOL.PRINTD, STRESS 

C CALLED  BY?  MAIN 

C 

C STATIC  SOLUTION  PHASE 

C 

COMMON  /one/A  (1) 

COMMON  /ELPAR/  NP  (14)  , NUMNP, MBAND, NELTYP, N1 ,N2,N3,N4,N5,MT0T,NEQ 
COMMON  /SOL  / NBLOCK,NEQB,LL,NF, I F I LL  (7) 
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common  /say/  neqq.numee, loopur , nnb lock, nterms, opt  ion 
common  /what/  naxa  (1 0000) , i row!  (1 0000) , i col h (10000) 
common  /time/  1 1 (8)  , t2  (8)  , t3  (8) 
c dimension  bb  (100) ,b (3. 1) 

integer  i ops  (8)  , i opf  (8) 

C 

REAL  TT  (4) 

End  declarations 
C 

C SOLVE  FOR  THE  DISPLACEMENT  VECTORS 
C 

C***  CALL  TT I ME  (TT  (1 ) ) 

if(me.eq.l)  tt  ( 1 ) =second  () 
c write  (6,*)  ' sub  soleq  begins' 

Barr i er 

NSB=  (MBAND+LL) *NEQB 
NSBB=NEQB*LL*  (2+  (MBAND-2) /NEQB) 

I F (NSBB.LT.NSB)  NSBB-NSB 
N4=N3+NSBB 
Ml  = MBAND  + NEQB  -1 
c moayyad 

if  (opt  i on . eq  . 1 .)  then 
do  119  i=l .neqq 
119  i row!  (i) =i row  I (i) -1 

n 1 = 1 

n2=nl+nterms 

c call  xload  (neqq, 1 1 ,a  (n2) ) 

c do  198  i 1 =1 , nterms 

cl98  write (6,*)'  a vector  before  row9',a(il) 
c do  199  i 1 =n2 , neqq 

cl99  write(6,*)'  load  vector  before  row9'.a(il) 
end  i f 

End  barrier 

if  (option. eq. 1 .)  then 
neqq=neq 
neqpl =neq+l 

i f (me . eq . 1 ) ts  1 “second  () 

1 1 (me)  “second  () 

Forcecal 1 row9  (a  (nl) ,a  (n2) ,naxa, i rowl , i col h, neqq, neqp 1 .nterms, 
61 , iopf  (me)  ,11) 

c write(6,*)‘  factorization  ends....' 

t2  (me)  “second  () 

write(l6,*)'  Factorization  time  of  proc . 1 ,me, 1 i s ' , t2 (me) -tl  (me) 
Forcecal 1 row9  (a (nl) ,a  (n2) ,naxa, i rowl , i col h , neqq , neqpl .nterms, 
62, iops  (me) ,11) 

t2  (me)  “second  () 

write(l6,*)'  Eqn  solver  time  of  proc . 1 ,me, 1 i s 1 , t2  (me) -t  1 (me) 
i f (me.eq. 1) then 
ts2“second  () 
tst“ts2-ts 1 

write(l6,*)'  cpu  time  for  the  eqn  solver:1, tst 
end  i f 
el  se 
Barr i er 

CALL  SES0L  (A (Nl) , A (N3) . A (N4) ,NEQ, MBAND, LL.NBL0CK, NEQB, NSB, Ml , 
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1 **,3.2,7) 

End  barrier 
end  i f 

C***  CALL  TTIME  (TT  (2) ) 

i f (me.eq.  1)  tt  (2)  “second  () 

C 

C PRINT  DISPLACEMENTS 
C 

Barr i er 
N2*N 1+NUMNP*6 
N3«N2+6*LL 

i f (opt i on .eq . 1 .)  then 
nblock=l 

neqb=neq 
End  if 

CALL  PRINTD  (A  (N 1 ) , A (N2)  , A (N3)  , NEQB , NUMNP, LL ,NBLOCK, NEQ, 2 , 1 ) 

C***  CALL  TTIME  (TT  (3) ) 

tt  (3)  “second  () 

C 

C COMPUTE  AND  PRINT  ELEMENT  STRESSES 
C 

N2=N 1+L*LL 

N3“N2+NEQB*LL 

LB“  (MT0T-N3) / (NEQ  +12) 

CALL  STRESS  (A  (Nl)  ,A(N2)  ,A(N3)  .NEQB,  LB.LL.NEQ.NBLOCK) 

C***  CALL  TTIME  (TT  (4) ) 

tt  ( k ) “second  () 

C 

C COMPUTE  TIME  LOG  FOR  THE  STATIC  SOLUTION  PHASE 
C 

DO  50  K*1 ,3 

50  TT(K)  = TT  (K+l)  -TT  (K) 

WRITE  (6,2000)  (TT  (L)  , L-l , 3) 

C 

2000  FORMAT  (////  48H  STATIC  SOLUTION  TIME  LOG, 

1 //5X.21HEQUATI0N  SOLUTION  =.  F8.2  / 

2 5X, 2 1 HD  I SPLACEMENT  OUTPUT  “,  F8.2  / 

3 5X.21HSTRESS  RECOVERY  =,  F8.2  /) 

C 

c ^ write  (6,*)  1 sub  soleq  ends' 

End  barrier 
RETURN 
END 

** *********************************************************** 

SUBROUT  I NE  STRESS  (STR , B , D , NEQB , LB , LL , NEQ.NBLOCK) 
c IMPLICIT  REAL*8(A-H,0-Z) 

C 

C CALLS?  ELTYPE 

C CALLED  BY?  SOLEQ 

C 

DIMENSION  D (NEQ,  LB)  , B (NEQB,  LL)  ,STR  (It , LL) 

COMMON  /ELPAR/  NPAR(U) , NUMNP, MBAND, NELTYP, Nl ,N2,N3,NL,N5,MT0T,MEQ 
COMMON  /JUNK/  LT, LH, I F I LL  (428) 

COMMON  /EXTRA/  M0DEX,NT8,N10SV,NT10, I F I LL2  (12) 


o o o 
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c 

C 


c*** 


c 

c 


write(6,*)'  sub  stress  begins 

READ  (8)  STR 
NT=(LL-1)/LB  +1 
LH=0 

STRESS  PORTHOLE 
IF  (NIOSV.EQ. 1) 

*WR ITE  (NT  10)  NELTYP , NT 

DO  1000  I 1*1 , NT 

LT  =LH+1 
LLT=1 -LT 
LH=LT+LB- 1 
IF(LH.GT.LL)  LH=LL 


MOVE  DISPLACEMENTS  INTO  CORE  FOR  LB  LOAD  CONDITIONS 


REWIND  2 

C***  STRESS  PORTHOLE 
I F (NIOSV.EQ.  1) 

*WR I TE  (NT  10)  LT.LH 
NQ=NEQB*NBLOCK 
DO  200  NN=1 , NBLOCK 
READ  (2)  B 
N=NEQB 

IF  (NN.EQ.l)  N=NEQ-NQ+NEQB 
NQ=NQ-NEQB 
DO  200  J=1,N 
I =NQ+J 

DO  200  L=LT , LH 
K=L+LLT 

200  D ( I ,K)=B(J,L) 

LK=LH-LT+1 

C 

C CALCULATE  STRESSES  FOR  ALL  ELEMENTS  FOR  LB  LOAD  CONDITIONS 
C 

REWIND  1 

DO  1000  M=1 .NELTYP 
READ  (1)  NPAR 
C***  STRESS  PORTHOLE 
IF  (NIOSV.EQ. 1) 
fcWRITE  (NT  10)  NPAR 
MTYPE-NPAR (1) 

NPAR  (1 ) “0 

CALL  ELTYPE  (MTYPE) 

1000  CONTINUE 
C 

c write (6,*)'  sub  stress  ends' 

RETURN 

END 

************************************************************************ 
SUBROUTINE  STRSC (STR , D , NEQ, NTAG) 

IMPLICIT  REAL*8(A-H,0-Z) 


c 

C 
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C CALLED  BY?  TRUSS , BE AM, PLANE .THREED , SHELL , BOUND , P I PE 
C 

DIMENSION  STR  (4, 1) ,D  (NEQ, 1) 

COMMON  /JUNK/  LT , LH , L , I PAD , SG  (20) , S I G (7)  , EXTRA (186) 

COMMON  /EM/  NS,ND,B(42,63)  ,TI  (42,4)  ,LM(63) 

C 

c write  (6,*)'  sub  strsc  bigins' 

IF  (NTAG.EQ.O)  GO  TO  800 

LL=L-LT+1 

DO  300  1-1, NS 

SG  (l)-0.0 

DO  300  J-l ,4 

300  SG ( I ) -SG  ( I ) +T I ( I , J) *STR  (J , L) 

DO  500  J-l , ND 
JJ-LM(J) 

IF  (JJ.EQ.O)  GO  TO  500 
DO  400  1-1, NS 

400  SG  (I)  =SG  (l)+B  (I  , J)  *D  (JJ.LL) 

C 

500  CONTINUE 
GO  TO  900 

800  READ  (1)  NO, NS,  (LM  ( I ) ,1  = 1, ND)  , ((  B (I , J) ,1-1, NS) , J- 1 . ND)  , 

1 ( (T I (I  , J)  ,1-1, NS)  , J-l, 4) 

900  RETURN 
END 

SUBROUTINE  TRUSS 
C 

c IMPLICIT  REAL*8  (A-H.o-Z) 

C CALLS?  RUSS, STRSC 

C CALLED  BY?  ELTYPE 

C 

COMMON  /one/A  (1) 

COMMON  /ELPAR/  NPAR(l4) , NUMNP , MB AND , NELTYP, N 1 , N2 , N3, N4 , N5 , MTOT , NEQ 
COMMON  /JUNK/  LT, LH , L , I PAD , S I G (20)  ,N6 , N7, N8.N9.N 10, I F I LL  (381 ) 
COMMON  /EXTRA/  M0DEX,NT8,N10SV,NT10, 1 F I LL2  (12) 
c common  /maybe/  dxx  (50) ,dyy  (50) ,dzz  (50) ,ee  (50) ,aa  (50) 

common  /say/  neqq, numee, 1 oopur , nnbl ock , nterms .option 
common  /what/  naxa (10000) , i rowl  (10000) , icolh (10000) 

C 

c write  (6,*)'  sub  truss  begins1 

I F (NPAR  (1)  .EQ.O)  GO  TO  500 
N6-N5+NUMNP 
N7  -N6+NPAR(3) 
n8  -N7+npar(3) 

N9  -N8+NPAR(3) 

N10-N9+NPAR(3) 

MM-N 10+NPAR  (3) -MTOT 
I F (MM.GT.O)  CALL  ERROR  (MM) 

C 

CALL  RUSS  (A  (N 1)  ,A(N2)  ,A(N3)  ,A(N4)  ,A(N5)  ,A(N6)  ,A(N7)  ,A(N8)  ,A(N9)  , 

1 A (N10) .NUMNP) 

C 

RETURN 

C 
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500  WRITE  (6,2002) 

NUME=NPAR  (2) 

DO  800  MM«1,NUME 

CALL  STRSC  (A  (Nl)  , A (N3)  ,NEQtO) 

WRITE  (6,2001) 

DO  800  L=LT, LH 

CALL  STRSC  (A  (Nl)  , A (N3)  ,NEQ,  1) 

WRITE  (6,3002)  MM,  L , S I G (1)  , S I G (2) 

C***  STRESS  PORTHOLE 
IF (N10SV.EQ.1) 

*WR  I TE  (NT  10)  MM,  L , S I G ( 1)  , S I G (2) 

800  CONTINUE 
RETURN 
C 

2001  FORMAT  (/) 

2002  FORMAT  (//23H1  TRUSS  MEMBER  ACTIONS  // 

i*6H0  MEMBER  LOAD  STRESS  FORCE  ) 

3002  FORMAT  (2  I 8 , F 1 5 . 5 . F 1 5 • 3) 

END 

************************************** ’k^***********************’1'******** 
subroutine  printd  ( i d , d ,b , neqb , numnp, 1 1 , nb 1 ock , neq , nt ,mq) 
c implicit  rea 1 *8  (a-h , o-z) 

c 

c called  by:  so  1 eq , sol e i g, respec 

c 

d i mens  ion  id  (numnp , 6) , b (neqb ,11) , d (6 , 1 1 ) 
data  q 1 1 , q2 1 , q 1 2 ,q22 , q 1 3 > q23/ ' load','  case 1 ei gen- 1 , 1 vector  1 , 

& 1 mode  ' , ' number  1 / 

c 

c wr i te  (6,*)  ' sub  printd  begind1 

rewind  8 
read  (8)  id 
m=neq 

nn=neqb*nb 1 ock 
c 

i f (mq .eq . 2)  go  to  50 
i f (mq .eq . 3)  go  to  55 
rewind  nt 

q 1 =q  1 1 

q2=q2 1 
go  to  60 
50  ql=ql2 

q2*q22 
go  to  60 
55  ql-ql3 

q2«q23 
rewind  nt 
read  (nt) 

60  wr i te  (6, 2003)  q1,q2 

n=numnp 
c 

do  500  kk*l, numnp 
c 

i-6 

do  250  i i = l ,6 
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do  100  1-1,1 1 
100  d (i  , 1)  —0. 

i f (m.gt.nn)  go  to  150 
i f (m.eq.O)  go  to  150 
read(nt)  b 
nn*nn-neqb 

150  if  (id  (n9  i)  . 1 1. 1)  go  to  250 

k-m-nn 
m=m- 1 
c 

do  200  1=1,11 
200  d ( i , 1 ) =b  (k  , 1 ) 

250  i-i-1 

c 

wri  te  (6,2004)  n,  ( 1 , (d  ( i , 1 ) , i = 1 , 6)  , 1 -1 , 1 1 ) 
c 

500  n=n-l 

c 

c write  (6,*)'  sub  printd  ends1 

return 
c 

2003  format  (lhl,1  node  displacements  ' ,/, 

& ‘rotations',//  3x , ^hnode, 2x , a6 , 2 (1 2x , 2hx- , 1 2x , 
6 2hy-, 12x,2hz-)  ,/7h  number  , 2x , a6 , 3 (3x , 1 1 h tr ans 1 at i on  ), 

S 3 (6x , 8hrotat i on)  , /lx) 

200i+  format  ( 1 hO , i 6 , i 8 , 6e  1 4 . 5 / (7x,  i 8, 6eU  .5) ) 
c 

end 


subroutine  x 1 oad  (neq , 1 1 , b) 
c implicit  rea 1 *8  (a-h , o-z) 

dimension  b (neq, 1 1) 
rewind  3 
read  (3)  b 

c write  (6,*)'  xload  neq  1 1 1 , neq , 1 1 

do  1 i =1 , neq 
c bb  ( i ) =b  ( i , 1 1 ) 

c write(6,*)  b (i  , 1)  , 1 bb  (i ) xload1 

1 continue 

return 
end 
c 

Forcesub  R0W9 (A,B,MAXA, IR0WL, I C0LH.NEQ.NEQP1 .NTERMS, I FLAG 
+ ,jops,lc)  of  NNP  ident  ME 

REAL  A (NTERMS)  , B (NEQ,  1 c) 

INTEGER  MAXA(NEQPl)  , I R0WL  (NEQ)  , I C0LH  (NEQ) 

INTEGER  jops 

Private  INTEGER  I , J , K, L , I Ml , I C 1 , I BOT, I COL , I COLP, ITOP , JROW, KM1 
Private  INTEGER  JM1 , JM2 , JM3, JM4 , JM5  > JM6, JM7 , JM8, jm9, I D I V, I D I VI 
Private  I NTEGER  JTOP, JBOT, I COPY, j j 1 ,jjrow 

Private  REAL  XMULT1 ,XMULT2,XMULT3,XMULn,XMULT5,XMULT6,XMULT7, 
+ XMULT8, TEMP, XINV, SUM 
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Async  REAL  X(lOOOl) 

End  Declarations 
write(6,*)'  row9  starts  H-H-++ 1 

Barr i er 

i f (me.eq.3)  then 
do  198  i 1*1 .nterms 

write  (6,*)'  a vector  at  the  beginning  of  row9',a(il) 
wr i te  (6,*) 'b.maxa, i rwl , i col h ' 
do  199  i 1 = 1 t neq 

wr  i te (6,*)  b (i 1 , 1) ,maxa  (i 1)  , i rowl  (i 1) , i col h (il) 

End  barrier 
end  i f 


I F (I FLAG.EQ. 1)  THEN 

Presched  DO  9 I = 1 » NEQ 
Void  X(l) 

End  Presched  Do 

write(*,*)  'void  has  been  completed' 
jops  = 0 
Barrier 
jops  = 0 

A (1)  = SQRT  (A  (1) ) 

X I NV  = 1 .0/A  (1) 

CD  I R$  IVDEP 

DO  20  K = 1 , I ROWL  (1) 

A (K+l ) = X I NV  * A (K+l ) 

20  CONTINUE 

c write(*,*)  'first  row  has  been  processed' 

jops  * jops  + irowl  (l)+2 
Produce  X (1)  =a  (1) 

c wr i te  (* , *)  'first  void  has  been  unvoided1 

End  Barrier 


C DECOMPOSED  STIFFNESS  MATRIX  PHASE 

Presched  DO  100  I - 2,  NEQ 

c TAKES  CARE  OF  ROWS  ONE  BY  ONE 

iml  * maxa  (i) 
icl  - icolh(i) 

c indices  calculation  for  using  the  modification  factor 

c from  the  upper  segment  of  column-height. 

ibot  - i - 9*(  O-D/9  ) 

icol  * icl  - ibot  + 1 
icolp*  icol/9 
i top  ••  icol  - 9*i  col  p 

c indices  calculation  for  modifcation  by  i top  elements. 

j row  ■ i - icl 

jml  = maxa  (j row)  + icl 

j j row=  i rowl  (j  row)  > 

c write(*,*)  1 i ml , i c 1 , i bot , i col , i col p, i top, j row, jml ' 


c 

c 

c 

c 

cl  98 

c 

c 

cl  99 
c 
c 
C 


9 

c 
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c write(*,*)  i m 1 , i c 1 , i bot , i col , i col p, i top, j row, jml 

IF  (ITOP.  GE.  1 ) THEN 

I COPY  * JROW  + ITOP  -1 

c If  (I sful 1 (x  (icopy) ) ) go  to  331 

Copy  X (I  COPY)  INTO  TEMP 

c write  (*,*)  'the  statement  i cop= 1 , i cop, ‘ has  been  checked1 

END  I F 

331  goto  (101,102,103,104,105,106,107,108),  itop 

C 

go  to  150 

CD  I R$  IVDEP 

101  do  111  k = 1,  jjrow-icl+1 

kml  = k -1 

a(iml+kml)  = a(iml+kml)  -a  (jml)  *a  (jml+kml) 

1 1 1 cont i nue 

go  to  150 

102  jm2  = jml  + jjrow 

CD  I R$  IVDEP 

do  112  k = 1,  jjrow-icl+1 
kml  = k -1 

a(iml+kml)  • a(iml+kml)  -a  (jml)  *a  (jml+kml) 

+ - a (jm2)  *a  (jm2+kml) 

1 1 2 cont i nue 
go  to  150 

103  jm2  = jml  + jjrow 

jm3  = jm2  + jjrow  -1 

CD  I R$  IVDEP 

do  113  k = 1,  jjrow  -icl+1 
kml  = k -1 

a(iml+kml)  * a(im1+kml)  - a (jml)  *a  (jml+kml) 

+ -a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+km1) 

1 1 3 conti nue 
go  to  150 

104  jm2  * jml  + jjrow 

jm3  ■ jm2  + jjrow  -1 

jm4  ■ jm3  + jjrow  -2 

CD  I R$  IVDEP 

do  114  k ■ 1,  jjrow  -icl+1 
kml  * k -1 

a(iml+kml)  ■ a(iml+kml)  - a (jml)  *a  (jml+kml) 

+ -a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+kml) 

+ -a  (jm4)  *a  (jm4+kml) 

114  continue 
go  to  150 

105  j m2  * jml  + jjrow 

jm3  = jm2  + jjrow  -1 
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jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 

CD  I R$  IVDEP 

do  1 15  k - 1 , jjrow  - i c 1+1 
kml  = k -1 

a (iml+kml)  - a(iml+kml)  - a (jml)  *a  (jml+kml) 

+ -a  (jm2)  *a  (jm2+kml ) -a  (jm3)  *a  (jm3+kml) 

+ -a  (jm4)  *a  (jm4+kml)  -a  (jm5)  *a  (jm5+km  1 ) 

115  continue 
go  to  150 

106  jm2  = jml  + j j row 

jm3  = jm2  + jjrow  -1 

jm4  = jnr>3  + jjrow  -2 

jm5  ■ jm4  + jjrow  -3 

jm6  = jm5  + jjrow  -4 

CD  I R$  IVDEP 

do  1 16  k - 1 , jjrow  - i c 1+1 
kml=  k -1 

a (iml+kml)  =a(iml+kml)  -a  (jml)  *a  (jml+kml) 

+ -a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+kml) 

+ -a  (jm4)  *a  (jm4+kml)  -a  (jm5)  *a  (jm5+km  1 ) 

+ -a  (jm6)  *a  (jm6+kml) 

1 1 6 cont i nue 
go  to  150 

107  jm2  = jml  + jjrow 

jm3  “ j m2  + j j row  - 1 

jm4  * jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 
jm6  = jm5  + jjrow  -4 
jm7  = jm6  + jjrow  -5 

CD  I R$  IVDEP 

do  117  k = 1 , jjrow  - i c 1+1 
kml  = k -1 

a (iml+kml)  «a(iml+kml)  -a  (jml)  *a  (jml+kml) 

+ -a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+kml) 

+ -a  (jm4)  *a  (jm4+kml)  -a  (jm5)  *a  (jm5+kml) 

+ -a  (jm6)  *a  (jm6+kml)  -a  (jm7)  *a  (jm7+kml) 

117  continue 
go  to  150 

1 08  jm2  - jml  + jjrow 

jm3  ■ jm2  + jjrow  -1 

jm4  - jm3  + jjrow  -2 

jm5  ■ jm4  + jjrow  -3 

jm6  * jm5  + jjrow  -4 

jm7  * jm6  + jjrow  -5 

jm8  * jm7  + jjrow  -6 

CD  I R$  IVDEP 

do  1 18  k * 1 , jjrow  - 1 c 1+1 
kml  * k -1 

a (iml+kml)  = a(iml+kml)  -a  (jml)  *a  (jml+kml) 

+ -a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+kml) 

+ -a  (jm4)  *a  (jm4+kml)  -a  (jm5)  *a  (jm5+kml) 

+ -a  (jm6)  *a  (jm8+kml)  -a  (jm7)  *a  (jm7+kml) 
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+ 

1 1 8 cont  i nue 

go  to  150 


C 


-a  (jm8)  *a  (jm8+kml) 


150  jops  = jops  + itop*(jjrow  - i c 1+2)  *2 

11  * 3 

i d i v * 1 

if  (icolp.le.il)  then 
11  =icolp 
i d i v 1 =1 
else 

i d i vl=i col p- 1 1+1 
end  i f 

j top  = i c 1 
jbot  = i c 1 - i top+1 

c wr i te (*,*)  ' 1 1 , i d i v, id i vl , j top, jbot 1 

c write(*,*)  1 1 , i d i v, i d ivl ,j top, jbot 

do  10  1 = 1 , 11 

j top  = j top  - i top 
jbot  * jbot  - 9* id ivl 
i top  = 9* id i vl 
i d i vl  = id i v 

if  (1 .eq.l 1)  then 
i copy  * i - 1 
else 

icopy  = i -jbot  +ibot-l 
end  i f 

c write(*,*)  'j top, jbot, i top, id ivl ' ,j top, jbot, itop, id ivl , i cop 
c If  (I  sf  ul  1 (x  (icopy) ) ) go  to  332 

Copy  X (icopy)  into  temp 


c 

332 


c 

c 

c 

c 

c 

c 

c 


write(*,*)  1 icop  has  been  cleared1 
do  200  j * j top , jbot,  “9 
JJ1  * l-J 

j j row  * i row!  (j  j 1) 
jml  * maxa  (j  j 1 ) + j 
jm2  = jml  + jjrow 
jm3  ■ jm2  + jjrow  -1 
jm4  - jm3  + jjrow  -2 
jm5  ■ jm4  + jjrow  -3 
jm6  * jm5  + jjrow  -4 
jm7  * jm6  + jjrow  -5 
jm8  ■ jm7  + jjrow  -6 
jm9  ■ jm8  + jjrow  -7 
xmul  1 1 * a (jml) 

XMULT2  - A (JM2) 

XMULT3  * A(JM3) 

XMULT4  = A (JM4) 
xmul  t5  ■ a (jm5) 
xmul  t6  « a (jm6) 
xmul  t7  * a (jm7) 
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c xmult8  = a(jm8) 

c xmul  t9  = a (jm9) 


CD  I R$  IVDEP 

DO  300  K = 1 , jjrow  -J  +1 


KM1  = K -1 
A (iml+kml) 


= A (iml+kml) 

-a  (jml)  *a  (jml+kml) 
-a  (jm3)  *a  (jm3+kml) 
-a  (jm5)  *a  (jm5+kml) 
-a  (jm7)  *a  (jm7+kml) 
-a  (jm9)  *a  (jm9+kml) 


300  CONTINUE 

jops  = jops  + l8*(  jjrow  -j+1) 


-a  (jm2)  *a  (jm2+kml ) 
-a  (j m4)  *a  (j m4+km  1 ) 
-a  (jm6)  *a  (jm6+kml) 
-a  (jm8)  *a  (jm8+kml) 


200  CONTINUE 

10  continue 


1 1 = i - 1 

C I f (I  sful  1 (x  (1  1) ) ) go  to  333 

Copy  x (11)  into  temp 

c wr i te  (* , *)  1 1 1 has  been  cl  eared ',11 

333  go  to  (201,202,203,204,205,206,207,208)  ibot-1 

go  to  250 


201  jjrow  = i rowl  (i  -1) 

jml  = maxa  (i  - 1)  +1 

CD  I R$  IVDEP 

00  211  K « 1,  jjrow 

KM1  = K -1 

A ( I M1+KM1 ) = A ( I M1+KM1)  - a(jml)*  A(JM1  +KM1) 

211  CONTINUE 
go  to  250 

202  jjrow  = irowl  ( i - 2) 

jml  = maxa  (i  -2)  +2 

JM2  = jml  + jjrow 

CD  I R$  IVDEP 

DO  212  K = 1 , jjrow  -1 
KM1  * K -1 

A ( I M1+KM1 ) * A (IM1+KM1)  - a (jml)  *a  (jml+kml) 

-A  (jm2)  *A  (JM2+KM1) 

212  CONTINUE 
go  to  250 

203  jjrow  - irowl  (i-3) 

jml  * maxa  (i  ~3)  + 3 
JM2  - jml  + jjrow 

JM3  = jm2  + jjrow  -1 

CD  I R$  IVDEP 

DO  213  K = 1,  jjrow  -2 
KM1=K  -1 

A ( I M1+KM1)  = A (I  M1+KM1)  -A  (jml)  *A  (JM1+KM1 ) 

-a  (jm2)  *A  (JM2+KM1)  -a  (jm3)  *A  (JM3+KM1) 
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213 
204 

CD  I R$ 

214 
205 

CD  I R$ 

215 
206 

CD  I R$ 

216 
207 


CONTINUE 
go  to  250 

j j row  = i rowl  (i  -4) 
jml  = maxa  (i -4)  + 4 
jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  * jm3  + jjrow  -2 

IVDEP 

do  214  k = 1, jjrow  -3 
kml  = k -1 

a(iml+kml)  = a(iml+kml)  -a  (jml)  *a  (jml+kml) 

-a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+kml) 
-a  (jm4)  *a  (jm4+kml) 

cont i nue 
go  to  250 

jjrow  = i rowl  (i~5) 
jml  = maxa  (i  -5)  + 5 
jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 

IVDEP 

do  215  4 = 1,  jjrow  -4 
kml  = k -1 

a(iml+kml)  = a(iml+kml)  -a  (jml)  *a  (jml+kml) 

-a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+kml) 
-a  (jm4)  *a  (jm4+kml)  -a  (jm5)  *A  (jm5+kml) 

cont i nue 
go  to  250 

j j row  = i rowl  (i -6) 
jml  = maxa  (i  -6)  +6 
jm2  = jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  = jm3  + jjrow  -2 
jm5  * jm4  + jjrow  -3 
jm6  * jm5  + jjrow  -4 

IVDEP 

do  216  k “ 1,  jjrow  -5 
kml  - k -1 

a(iml+kml)  = a(iml+kml)  -a  (jml)  *a  (jml+kml) 

-a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+km1) 
-a  (jm4)  *a  (jm4+kml)  -a  (jm5)  *a  (jm5+kml) 
-a  (jm6)  *a  (jm6+kml) 

cont i nue 
go  to  250 

j j row  ■ i rowl  (i -7) 
jml  * maxa  (i  -7)  +7 
jm2  ■ jml  + jjrow 
jm3  = jm2  + jjrow  -1 
jm4  ■ jm3  + jjrow  -2 
jm5  = jm4  + jjrow  -3 
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CD  I R$ 

217 

208 

CD  I R$ 


218 
C. . . . 
250 
c 

CD  I R$ 

260 

c 

c 

100 
c. . . . 


FRC 


jm6  = jm5  + jjrow  -U 
jm7  = jm6  + jjrow  -5 

IVDEP 

do  217  k = 1 , jjrow  -6 
kml  = k -1 

a (iml+kml)  =a(iml+kml)  -a  (jml)  *a  (jml+kml) 

-a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+kml) 
-a  (jm4)  *a  (jm4+kml)  -a  (jm5)  *a  (jm5+kml) 
-a  (jm6)  *a  (jm6+kml)  -a  (jm7)  *a  (jm7+kml) 

conti nue 
go  to  250 

j j row  =i rowl  (i -8) 
jml  = maxa  (i  -8)  + 8 
jm2  = jml  + jjrow 
jm3  - jm2  + jjrow  -1 
jmL  = jm3  + jjrow  -2 
jm5  * jmL  + jjrow  -3 
jm6  = jm5  + jjrow  -k 
jm7  = jm6  + jjrow  -5 
jm8  = jm7  + jjrow  -6 

IVDEP 

do  218  k = 1 , jjrow  -7 
kml  = k -1 

a (iml+kml)  = a (Iml+kml)  - a (jml)  *a  (jml+kml) 

-a  (jm2)  *a  (jm2+kml)  -a  (jm3)  *a  (jm3+kml) 
-a  (jmL)  *a  (jmU+kml)  -a  (jm5)  *a  (jm5+kml) 
’ -a  ( j m6)  *a  (jm6+kml)  -a  (jm7)  *a  (jm7+kml) 

- a ( j m8)  *a  ( j m8+km  1 ) 

conti nue 
go  to  250 


jops  = jops  + 2*  (ibot-1)  * (jjrow  -ibot  +2) 
A (I  Ml)  =SQRT  (A  ( I Ml ) ) 

WR I TE  (6 , *)  1 A ( 1 , I Ml , 1 ) = ' , A ( I Ml) 

XINV  = 1 .0/A  ( I Ml ) 

IVDEP 

DO  260  K = 1 , I ROWL  (I) 

A ( I Ml+K)  = XINV  *A(IM1+K) 

CONTINUE 

jops  = jops  + irowl  (i)  +2 
Produce  X ( I ) * A ( I Ml) 
write(*,*)  'row', i, 'is  cleared1 
WRITE  (6,*)  (A  (IM1+L)  ,L-1 , IROWL  (I)) 

End  Presched  Do 
ELSE 

FORWARD  REDUCTION 

do  196  lo*1 , lc 
Barr i er 

jops  ■ 0 

DO  510  I = l.NEQ 

B ( I , 1 o)  = B ( I , 1 o)  /A  (MAXA  ( I ) ) 

SUM  = B (I  , lo) 
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I Ml  -MAXA(I) 

CD  I R$  IVDEP 

DO  520  J * 1 + 1 , l + IROWL  (I) 

B (J  , 1 o)  = B (J , 1 o)  - SUM*  A ( I Ml+J- 1 ) 

520  CONTINUE 

jops  * jops  + 2*  (i  rowl  (i))+  2 
510  CONTINUE 

C BACK  SUBSTITUTION 

B (NEQ,  lo)  = B (NEQ,  lo)  /A  (MAXA  (NEQ) ) 
jops  = jops  +1 
DO  1010  I = NEQ-1,1,-1 
SUM  - 0.0 

CD  I R$  IVDEP 

DO  1020  J *1+1,  I ROWL ( I ) + I 

SUM-SUM+  A (MAXA  ( I ) +J-  I ) *B  (J , 1 o) 

1020  CONTINUE 

B ( I , 1 o)  = (B  ( 1 , 1 o)  -SUM)  /A  (MAXA  ( I ) ) 
jops  * jops  + 2*(irow1(i))  +2 
1010  CONTINUE 
End  Barrier 
196  continue 
END  i F 

c do  1 29  i i =1  * neq 

c 1 29  wr  i te  (6, *)  b (i  i f 1 ) 

Bar r i er 
rewind  2 

wr  i te  (2)  ( (b  ( i , 1 o)  , i = 1 , neq)  , lo*l , 1c) 
c write(6,*)‘  sub  row9  ends . . . ,++++ M 1 

End  barrier 
RETURN 
END 

subroutine  column 

common  /say/  neqq , numee , 1 oopur , nnb 1 ock , n terms , opt i on 
common  /what/  naxa  (10000) , i rowl  (10000) , icol h (10000) 
cnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn 
c specify  the  level  of  loop  unrolling 

c modify  the  row  length  for  loop  unrol  purpose 

nnb 1 ock*neq/ 1 oopur 

c wr i te  (6 , *)  1 nnb lock, . neq f 1 oopur 1 , nnb lock f neq, 1 oopur 

lef tov*neq-  (nnb 1 ock*l oopur) 
c 

maxcol*0 

do  5 i *1 > nnblock 

i start*  (i -1) *loopur+l 

i end*i * 1 oopur 

do  6 jrow*i start, lend 

jcol*jrow+i  rowl  (jrow)  -1 

i f (jcol  .gt.maxcol)  maxcol*jcol 

6 continue 

c now  increase  each  row  length  for  loopur  purpose 

do  7 j row* i start, i end 

7 irowl  (j row) *maxcol -j row+1 

5 continue 

now  take  care  of  the  left  over  row 
i start=nnblock*loopur+l 


c 
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i end=neq 

do  8 j row= i star t , i end 
8 i rowl  (j  row) -neq-jrow+1 

c8888888888888888888888888888888888888888  column  height 

c to  f i nd  the  column  height 

cn  i col h (neq) *0 

cn  do  9^  i =neq- 1 ,1,-1 

cn  i r 1 = i rowl  ( i ) 

cn  do  92  j=i , i+i r 1-1 

cn92  i col h (j) =j - i 

cn91  continue 

c **************************************** 
c find  the  location  of  the  diagonal  terms 

naxa  (1)  = 1 
do  11  i=2,neq 

11  naxa  ( i ) =naxa  ( i - 1)  + i rowl  ( i - 1) 

c find  the  total  number  of  terms 

nterms*naxa  (neq) 

cnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnn 
c to  find  the  column  height 

icol h (neq) =0 
do  91  i =neq- 1 ,1,-1 
i r 1 = i rowl  (i ) 
do  92  j=i , i+i r 1 -1 
92  icolh  (j)  *j-i 

91  continue 

c update  row  length  not  to  include  the  diagonals 

c do  17  i=l.neq 

cl7  i rowl  (i )=  i rowl  ( i )- 1 

c 

return 

end 

a****************  beam  subroutines 
SUBROUTINE  BEAM 
C 
C 

C CALLS?  TE AM, STRSC 

C CALLED  BY?  ELTYPE 

C 

COMMON  /ELPAR/  NPAR  (1  A) , NUMNP,MBAND,NELTYP,N1 ,N2,N3,N4,N5,MT0T , NEQ 
COMMON  /JUNK/  LT , LH , L , I PAD , S I G (20) , N6 ,N7 ,N8,N9, N10, I F I LL (381 ) 
COMMON  /EXTRA/  MODEX,NT8,N10SV,NT10, I F I LL2 (12) 

C***  COMMON  A (1) 

COMMON  /one/A  (1) 

common  /say/  neqq.numee, loopur.nnb lock, nterms, opt  ion 
common  /what/  naxa  (10000) , i rowl  (10000) , icolh (10000) 
c COMMON  A (7100) 

C 

I F (NPAR  (1)  . EQ.O)  GO  TO  500 
N5A-N5+NUMNP 
N6=N5+NPAR  (5)  + NUMNP 
N7-N6+NPAR  (5) 

N8=N7+NPAR(5) 

N9=N8+12*NPAR(4) 

N10=N9+6*NPAR(3) 
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N 1 1 =N 1 0+NPAR  (5) 

I F (N1 1 .GT.MTOT)  CALL  ERROR  (N 1 1 -MTOT) 

C 

CALL  TEAM  (NPAR  (2)  ,NPAR(3)  ,NPAR  (4)  ,NPAR(5)  ,A(N1)  ,A(N2)  ,A(N3)  , 

1 A(N4)  ,A(N5A)  ,A(N6)  ,A(N7)  ,A(N8)  ,A(N9)  ,A(N10)  , 

2 NUMNP.MBAND) 

C 

RETURN 

C 

500  WRITE  (6,2002) 

NUME=NPAR (2) 
numee=nume 
neqq-neq 

DO  800  MM* 1 , NUME 

CALL  STRSC  (A  (N 1)  , A (N3)  , NEQ, 0) 

WRITE  (6,2001) 

DO  800  L*LT, LH 

CALL  STRSC  (A  (N  1)  , A (N3)  , NEQ,  1) 

WRITE  (6,3002)  MM.L,  (SIG  (I) , 1 = 1 , 12) 

C***  STRESS  PORTHOLE 
I F (N10SV.EQ. 1) 

*WRITE  (NT10)  MM.L,  (SIG  (I) , 1=1 , 12) 

800  CONTINUE 
RETURN 

2001  FORMAT  (/) 

2002  FORMAT  (/29H1 BEAM  FORCES  AND  MOMENTS// 

. 10H0BEAM  LOAD  5X  5HAXIAL  2 (7X , 5HSHEAR) , 5X  7HT0RSI0N 
. 2 (5X.7HBENDING)/  10H  NO.  NO.  8X  2HR1  10X  2HR2  10X 

. 2HR3  10X  2HM 1 10X  2HM2  10X  2HM3) 

3002  FORMAT  ( 1 5 , 1 A , 1 PE  1 1 . 3 , 5E 1 2 . 3/8x , 6E 1 2 . 3/) 

END 

SUBROUTINE  ERROR  (N) 

WRITE  (6,2000)  N 

2000  FORMAT  (//  20H  STORAGE  EXCEEDED  BY  16) 

STOP 

END 

SUBROUT  I NE  NEWBM (E , G , RO , WGHT, COPROP , SFT.NUMF I X.NUMETP) 

C 

C CALLED  BY?  TEAM 

C 

C FORM  NEW  BEAM  STIFFNESS 

C 

DIMENSION  E(l)  , G (1)  , RO  ( 1 ) , COPROP  (NUMETP , 1)  ,SFT  (NUMF  I X,  1)  ,WGHT(1) 
COMMON/EM/LM  (24) ,ND,NS, ASA  (24, 24) ,RF (24,4) ,XM(24) ,SA(12,24)  , 

1 SF  (12,4)  ,XWT(24)  , I FILL  (3000) 

COMMON  /NEWB/  LC (4) ,T  (3 , 3)  » JK (6) ,MELTYP,MATTYP, DL 
DIMENSION  R (1 2)  , S ( 1 2 , 1 2)  . C (12) 

C 

DO  5 1-1 ,12 
DO  5 J-1,12 
5 S (I , J) =0.0D0 

AX=COPROP  (MELTYP, 1) 

AY=COPROP (MELTYP , 2) 

AZ=COPROP (MELTYP, 3) 

AAX=COPROP  (MELTYP, 4) 
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AAY=COPROP  (MELTYP.5) 

AAZ=COPROP  (MELTYP.6) 

SHFY=0.0 
SHFZ=0 .0 

ZY=E  (MATTYP) / (DL*DL) 

E I Y=ZY*AAY 
E I Z=ZY*AAZ 

IF  (AY. NE. 0.0)  SHFY=6.*E I Z/(G  (MATTYP) *AY) 

IF  (AZ.NE.O.O)  SHFZ=6.*E I Y/ (G  (MATTYP) *AZ) 

C0MMY=EIY/(1 .+2.*SHFZ) 

COMMZ=E I Z/  (1 .+2.*SHFY) 

C 

C FIXED  END  FORCES  IN  LOCAL  COORDS 

C 

DO  73  N=l,4 
M=LC  (N) 

IF  (M.GT.O)  GO  TO  71 
DO  70  1-1,12 

70  SF  (I  ,N)=0. 

GO  TO  73 

71  DO  72  1-1,12 

72  SF (I , N)  -SFT  (M, I) 

73  CONTINUE 
C 

c FORM  ELEMENT  STIFFNESS  IN  LOCAL  COORDINATES 
C 

S (1 , 1)  « E (MATTYP)*  AX/DL 
S(4,4)  = G (MATTYP)  *AAX/DL 
S (2 , 2)  = C0MMZ*12./DL 
S (3,3)=  C0MMY*12./DL 
s (5,5) = COMMY*  4.*DL*  (1 .+0.5*SHFZ) 

S (6,6)  = COMMZ*  4.*DL*  (1 .+0.5*SHFY) 

S (2 , 6) - COMMZ*  6. 

S (3,5)=-C0MMY*  6. 

DO  102  1=1,6 
J=  I +6 

102  S (J  , J)  =S  (I  ,1) 

DO  104  1=1,4 
J=  I +6 

104  S (I  ,J)=-S  (I  , I) 

S (6, 1 2)  = S (6,6)  * (1  . -SHF Y)  / (2  .+SHFY) 

S (5.  1 1)  = S(5,5)*(l.“SHFZ)/(2.+SHFZ) 

S (2 , 1 2)  = S (2 ,6) 

S (6,  8)  =-S  (2,6) 

S (8, 12)  =-S  (2,6) 

S (3, 1 1)  - S (3,5) 

S (5,  9)  — s (3.5) 

SC9.il)— S (3. 5) 

DO  106  1=2,12 
K=  I - 1 

DO  106  J=1  ,K 
106  S ( I , J)  =S  (J , I ) 

C 

c MODIFY  ELEMENT  STIFFNESS  AND  ELEMENT  FIXED  END  FORCES  FOR  KNOWN 
C ZERO  MEMBER  END  FORCES. 
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IF  ( (JK  ( 1) +JK  (2) ) .EQ.O)  GOTO  145 
DO  140  K=1 , 2 
KK=JK  (K) 

KD= 100000 
I 1-6*(K-1)+1 
I 2=1 1+5 

DO  140  1=11,12 
IF  (KK.LT.KD)  GO  TO  140 
SI  l=S  (I  , I) 

DO  125  N-l, 12 
125  R (N)  =S  ( I , N) 

DO  130  M= 1 , 1 2 
C(M)=S(M,  l)/SI  I 
DO  130  N=1 , 12 

130  S(M,N)=S(M,N)-C(M)*R(N) 

DO  135  N=1 , 4 
SF  I =SF  (I  ,N) 

DO  135  M=1 , 12 

135  SF (M,N)  =SF (M,N) -C (M) *SF I 

136  KK=KK-KD 
140  KD=KD/10 
145  CONTINUE 

C 

C OBTAIN  SA  (1 2 , 1 2)  RELATING  ELEMENT  END  FORCES  (LOCAL)  AND 
C JOINT  DISPLACEMENTS  (GLOBAL). 

C 

DO  31  1=1,12 
DO  31  J=1 ,24 

31  SA  (I  , J)  =0.000 

DO  150  L A= 1 , 10,3 
LB=LA+2 

DO  150  MA= 1 , 10,3 
MB=MA- 1 

DO  150  I =LA , LB 
DO  150  JM=1 ,3 
J=JM+MB 
XX=0. 

DO  151  K-1,3 

151  XX=XX+S ( I , K+MB) *T (K , JM) 

150  SA  (I  , J)  =XX 
C 

C ELEM  STIFF  ASA  (12,12)  AND  FIXED  END  FORCES  RF(12)  IN  GLOBAL  COORDS 
C 

DO  32  1=1,24 
DO  32  J-1,24 

32  ASA  (I , J) =0.0D0 
DO  160  LA-1,10,3 
LB=LA- 1 

DO  160  MA=1 , 10,3 
MB-MA+2 
DO  160  IL-1,3 
I = I L+LB 

DO  160  J=MA , MB 
XX=0. 
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DO  1 6 1 K=1 , 3 

16 1 XX=XX+T  (K, I L) *SA (K+LB, J) 

1 60  ASA  ( I , J) =XX 

C 

DO  165  LA-1,10,3 
LB=LA- 1 
DO  165  IL-1,3 
1=1 L+LB 
DO  165  N™ 1,4 
XX=0. 

DO  162  K=1 ,3 

162  XX=XX-T  (K, I L) *SF  (K+LB.N) 

165  RF  0 ,N)-XX 

C 

C FORM  MASS  AND  GRAVITY  LOAD  MATRIX 
C 

XXM=RO  (MATTYP) *AX*DL/2 . 

WTM-WGHT  (MATTYP) *AX*DL/2 . 

DO  180  M=1 ,3 
XWT (M) =WTM 
XWT (M+3) =0 . 

XWT (M+9) =0 . 

XWT  (M+6) =WTM 
XM  (M)  =XXM 
XM  (M+3)  =0 . 

XM  (M+9) =0 . 

180  XM  (M+6) =XXM 
RETURN 
END 

SUBROUTINE  SLAVE  (X , Y , Z , I D , NUMNP , N I , NJ) 

C 

C CALLED  BY?  TEAM 

C 

C PERFORMS  SLAVE. . .MASTER  DISPLACEMENT  TRANSFORMATION 
C ( FOR  NODES  CONNECTED  TO  BEAM  ELEMENTS  ONLY) 

C 

DIMENSION  X (1) ,Y  (1) ,Z (1) , ID  (NUMNP, 1) 

COMMON  /EM/  LM(24)  ,ND,NS,S  (24,24)  ,R(96)  .XM(24)  ,SA(12,24) 
1 , I FILL  (3048) 

COMMON  /EXTRA/  M0DEX.NT8 

C DETERMINE  REQUIRED  TRANSLATION  DEGREES  OF  FREEDOM 

C 

DO  54  NF-1 , 12,6 
NOD-NI 

IF  (NF.EQ.7)  NOD-NJ 
DO  30  K-1,3 
l-K+NF-1 

IF  (LM  ( I ) .GE.O)  GO  TO  30 
M— LM  (I) 

LM  ( I ) = I D (M,  K) 

I F (K  — 2)  35.45,55 
35  Dl— (Y(NOD)-Y(M)) 

D2=  Z (NOD)  -Z  (M) 

LM  (ND+1)  *1  D (M,6) 

LM  (ND+2)  = I D (M,  5) 


,TT  (1 2 , 4) 
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GO  TO  50 

1*5  01—  (Z  (NOD)  -Z  (rt) ) 

D2=  X (NOD)  -X  (M) 

LM  (ND+1)  *1  D (M,l*) 

LM  (ND+2)  = I D (M,  6) 

GO  TO  50 

55  Dl—  (X(NOD)-X(M)) 

D2=  Y (NOD)  -Y  (M) 

LM (ND+1 ) ■ I D (M,  5) 

LM  (ND+2)  = I D (M,  4) 

50  CONTINUE 

IF  (MODEX.EQ.l)  GO  TO  80 
C TRANSFORMATION. . .ARRAYS  INCREASE  IN  SIZE 
C 

DO  60  I I«1 ,ND 
S (ND+1  , I I)  =S  (I  , I I)  *D1 
S (ND+2,  I l)-S  (I  , I I)  *D2 
S (I  I , ND+1 ) ■ S ( I I , I ) *D1 
S (I  I , ND+2)  = S (I  I , I)  *D2 
60  CONTINUE 

XM  (ND  + 1)  * XM  ( I ) *D 1 *D 1 
XM  (ND  + 2)  = XM  ( I ) *D2*D2 
C 

DO  70  11=1 ,NS 
SA  ( I I , ND+1 ) =S  A (I  I , I)*D1 
70  SA  (I  I , ND+2) =SA  ( I I , I) *D2 
C 

S (ND+1 ,ND+1) «S  (I , I) *D1**2 
S (ND+2 , ND+2) -S  ( I , I ) *D2**2 
S (ND+1 , ND+2) “S  ( I , I ) *D 1 *D2 
S (ND+2, ND+1) =S (ND+1 ,ND+2) 

80  ND  - ND  + 2 
30  CONTINUE 
C 

C SET  ROTATIONS 
C 

DO  54  J-1,3 
K-NF+J+2 

I F (LM  (K)  . GE .0)  GO  TO  54 
M—  LM(K) 

LM(K)-ID  (M.J+3) 

54  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  TEAM  (NBEAM.NUMETP.NUMF I X.NUMMAT, I D,X,Y,Z,E,G,RO, 

1 SFT, COPROP, WGHT,NUMNP,MBAND) 

C 

C CALLS?  NEWBM, SLAVE, CALBAN 

C CALLED  BY?  BEAM 

C 

C FORMS  3-D  BEAM  STIFFNESS  AND  STRESS  ARRAYS 

C 

COMMON/EM/LM  (24) , ND , NS , ASA (24,24) , RF (24,4)  ,XM(24)  ,SA (12,24)  , 
1 SF  (12,4)  ,XWT(24)  , IFILL(3000) 
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COMMON  /NEWB/  LC (4)  ,T (3 , 3)  . JK (6)  , MELTYP .MATTYP, DL 
COMMON  /EXTRA/  M0DEX.NT8, I F I LL2  (14) 

DIMENSION  X (1)  , Y (1)  ,Z  (1)  , ID  (NUMNP,  1)  , E (1)  ,G  (1)  ,SFT  (NUMF  IX,  1) 
1 .COPROP (NUMETP, 1)  ,RO  (1) , EMUL  (3,4)  , WGHT  (1) 

DIMENSION  I LC  (4) ,TI  (3,3) ,TJ  (3,3)  <STI F (722) ,TS  (2,2) ,LS  (4) 
common  /say/  neqq , numee, loopur , nnblock .nterms.opt ion 
common  /what/  naxa  (10000) , i rowl  (10000) , icol h (10000) 
EQUIVALENCE  (STI  F (1)  , LM  (1) ) 

C 

C 

c INITIALIZATION 

C 

WRITE  (6,2005)  NBEAM, NUMETP, NUMF I X.NUMMAT 
N=0 

DO  5 1=1 . 1058 
5 ST  IF  (l)=0. 

C 

C READ  AND  PRINT  MATERIAL  PROPERTY  DATA 

C 

WRITE  (6,2001) 

DO  10  1=1, NUMMAT 

READ  (5,1001)  N,E  (N)  ,G  (N)  ,R0  (N)  ,WGHT  (N) 

WRITE  (6,2002)  N , E (N)  ,G(N)  ,RO(N)  , WGHT  (N) 

10  G(N)-0.5*E(N)/(1.+G(N)) 

C***  DATA  PORTHOLE  SAVE 
IF  (MODEX.EQ. 1) 

*WRITE  (NT8)  (E  (N) ,G  (N) ,R0  (N)  ,N=1 .NUMMAT) 

C 

C READ  AND  PRINT  GEOMETRIC  PROPERTIES  OF  COMMON  ELEMENTS. 

C 

WRITE  (6,2003) 

DO  30  1=1 .NUMETP 

READ  (5,1002)  N,  (COPROP  (N,J) ,J=1 ,6) 

I F ( (COPROP  (N, 1)  .NE  .0.0)  .AND . (COPROP  (N,4) .NE .0.0)  .AND. 

1 (COPROP  (N , 5)  .NE .0 .0)  . AND . (COPROP  (N , 6)  .NE  .0 .0) ) GO  TO  20 
WRITE  (6,2013) 

STOP 

20  WRITE  (6,2004)  N , (COPROP  (N , J) , J=1 , 6) 

30  CONTINUE 

C***  DATA  PORTHOLE  SAVE 
IF  (MODEX.EQ. 1) 

*WR I TE  (NT8)  ( (COPROP  (N, J) ,J- 1,6) ,N=1, NUMETP) 

C 

C ELEMENT  LOAD  MULTIPLIERS 
C 

READ  (5.1006)  ((EMUL  (I  ,J)  ,J«1,4)  ,1  = 1,3) 

WRITE  (6,2006)  ( (EMUL  (I  , J)  , J«1 ,4)  , 1 = 1 ,3) 

C***  DATA  PORTHOLE  SAVE 
IF (MODEX.EQ. 1) 

*WRITE  (NT8)  ( (EMUL  (I  , J)  , J=1 ,4)  , 1*1 ,3) 

C 

C READ  AND  PRINT  FIXED  END  FORCES  IN  LOCAL  COORDINATES 
C 

IF  (NUMF IX  .EQ.  0)  GO  TO  5& 

WRITE  (6,2010) 
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DO  55  1*1 ,NUMF IX 

READ  (5,1005)  N,  (SFT(N.J)  , J-1,12) 

55  WRITE  (6,2011)  N,  (SFT(N.J)  , J-1,12) 

C***  DATA  PORTHOLE  SAVE 

IF  (MODEX.EQ. 1) 

*WR I TE  (NT8)  ( (SFT  (N,J) ,J=1 , 12) ,N=1 , NUMF I X) 

56  CONTINUE 
C 

C READ  AND  PRINT  ELEMENT  DATA.  GENERATE  MISSING  INPUT. 

C 

WRITE  (6,4000) 

L-0 

60  KKK-0 

READ  (5,3000)  INEL, INI , INJ, INK, IMAT, IMEL, ILC, INELKI , INELKJ, INC 

IF  (INEL.NE. 1)  GO  TO  15 

NI-INI 

NJ= I N J 

NK-INK 

15  IF  (INC.EQ.O)  I NC=1 

65  L-L+l 
KKK-KKK+1 
ML= I NEL-L 

IF  (ML)  66,67,68 

66  WRITE  (6,4003)  INEL 
STOP 

67  N E L= I NEL 

N I -INI 

NJ  -INJ 

NK-INK 
MATTY P= I MAT 
MELTYP- 1 ME  L 
DO  90  1-1,4 

90  LC(I)=ILC(I) 

NLOAD-LC  (1)+LC  (2)+LC  (3)+LC  (4) 

NEKOD I = I NELK I 
NEKODJ- I NELKJ 
DO  91  1=1,3 

91  T (2 , I ) -T I (2,1) 

GO  TO  69 

68  NEL-I NEL-ML 

N I = I N+KKK* I NCR 

NJ  -JN+KKK* I NCR 

69  CONTINUE 

WRITE  (6,4001)  NEL, Nl ,NJ,NK,MATTYP, MELTYP, LC.NEKODI .NEKODJ 
C***  DATA  PORTHOLE  SAVE 
IF  (MODEX.EQ. 1) 

*WR I TE  (NT8)  NEL, Nl ,NJ,NK,MATTYP, MELTYP, LC.NEKODI .NEKODJ 
C 

74  DX-X (NJ) -X (N I ) 

DY-Y  (NJ)  -Y  (Nl) 

OZ-Z  (NJ)-Z(NI) 

DL-SQRT (DX*DX+OY*DY+DZ*DZ) 

IF(DL)  75,75,76 

75  WRITE  (6,4005)  NEL 
STOP 
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C 

C FORM  GLOBAL  TO  LOCAL  COORDINATE  TRANSFORMATION. 

C 

76  T (1 , 1)  -DX/DL 
T (1 , 2)  =DY/DL 
T(l,3)=OZ/DL 
C 

C COMPUTE  DIRECTION  COSINES  OF  LOCAL  Y-AXIS 
C 

A1-X  (NJ) -X  (Nl) 

A2=Y  (NJ)  -Y  (Nl) 

A3=Z  (NJ)  -Z(NI) 

B 1=X  (NK)  -X  (Nl) 

B2=Y  (NK)  -Y  (Nl) 

B3=Z  (NK)  -Z  (Nl) 

AA=A 1 *A 1+A2*A2+A3*A3 

AB=A 1 *B 1+A2*B2+A3*B3 

U1=AA*B1-AB*A1 

U2=AA*B2-AB*A2 

U3=AA*B3-AB*A3 

UU=U1*U1+U2*U2+U3*U3 

UU=SQRT  (UU) 

IF  (UU.GT.O.)  GO  TO  40 
WRITE  (6,4002)  INEL 
STOP 

40  CONTINUE 

I F (MODEX.EQ. 1)  GO  TO  1 85 
T(2,  D-Ul/UU 
T (2 , 2)  =U2/UU 
T(2,3)=U3/UU 

T (3, 1)  =T  0 , 2)  *T  (2,3)  -T  (1 . 3)  *T  (2,2) 

T (3. 2)  =T  (1  , 3)  *T  (2 , 1)  “T  (1 , 1)  *T  (2 , 3) 

T (3 • 3)  “T  ( 1 * 1 ) *T  (2 , 2)  -T  (1 ,2)  *T  (2, 1) 

C 

C CHECK  IF  NEW  STIFFNESS  NEEDED 
C 

IF  (NEL.GE.1)  GO  TO  80 

IF  (ABS(DS-DL)  .GT.  DL/100.)  GO  TO  80 

IF  ( (MT.NE .MATTYP)  .OR. (ME .NE.MELTYP) ) GO  TO  80 

IF  ( (JK  (1)  .NE.NEKODI)  .OR.  (JK  (2)  .NE.NEKODJ))  GO  TO  80 

DO  81  1=1,4 

IF  (LS  ( I ) .NE.LC(I))  GO  TO  80 

81  CONTINUE 

DO  82  1=1,2 
DO  82  J=l,2 

IF  (ABS(TS(I.J)-T(I  ,J))  .GT.  ABS  (T  (I  . J) /100.) ) GO  TO  80 

82  CONTINUE 
GO  TO  185 

C 

80  DS=DL 

MT=MATTYP 
ME»MELTYP 
DO  77  1*1.2 
DO  77  J*1 » 2 
77  TS  (I  ,J)=T(I  ,J) 
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DO  78  1-1,4 
78  LS(I)-LC(I) 

JK  (l)-NEKODI 
JK  (2) -NEKODJ 
C 

C FORM  NEW  STIFFNESS 

C 

CALL  NEWBM(E,G,RO,WGHT, COPROP, SFT.NUMF I X.NUMETP) 

C 

C ADD  GRAVITY  LOADING  ...  POINT  LOADS  ONLY  COMPUTED 
C 

DO  180  1-1,3 
DO  180  J-1,4 

RF  (I  ,J)-RF  (I  , J)  +EMUL  ( I ,J)*XWT(I) 

180  RF  (1+6, J)  -RF  ( 1+6 , J)  +EMUL  (I  , J)  *XWT(l+6) 

C 

C FORM  ELEMENT  LOCATION  MATRIX 

C 

185  CONTINUE 

DO  170  M-1,6 
LM(M)-ID  (N  I , M) 

LM  (M+l 2) =0 
LM  (M+l8) =0 
170  LM(M+6)  - ID  (NJ.M) 

C 

NS=1  2 
ND-  1 2 
C 

C TRANSFORM  TO  MASTER  DEGREES  OF  FREEDOM 

C 

C 

CALL  SLAVE  (X, Y , Z , ID, NUMNP, N I , NJ) 

C 

C WRITE  ELEMENT  INFORMATION  ON  TAPE 
C 

NDM-24 

CALL  CALBAN  (MBAND , ND I F , LM, XM, ASA, RF .ND.NDM.NS) 

I F (MODEX.EQ. 1)  GO  TO  300 

WRITE  (1)  ND.NS,  (LM  (I)  , 1 — 1 , N D)  , ( (S A (I  , J)  ,1-1  ,NS)  , J-l  ,ND)  , 
1 ((SF(I,J)  ,1-1, NS), J-l, 4) 

C 

C CHECK  FOR  LAST  ELEMENT 

C 

300  IF  (NBEAM-NEL)  66,500,260 
260  CONTINUE 

IF  (ML.GT.O)  GO  TO  65 
IN  -INI 

JN  -INJ 

INCR-INC 
GO  TO  60 
500  RETURN 
C 

1001  F0RMAT(I5,4F10.0) 

1002  F0RMAT(I5,6F10.0) 

1005  F0RMAT(I5,6F10.0/F15.0,5F10.0) 
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1006  FORMAT 
C 

2001  FORMAT 
1 
2 


(1*F  10.0) 

(///  20H  MATERIAL  PROPERTIES,  //  5X , 8HMATER I AL , 8X , 
7HY0UNG*S,6X,9HP0ISS0N*S,11X,1*HMASS,9X.6HWEIGHT,  / 7X, 
6HNUMBER.8X.7HM0DULUS, 10X.5HRATI0.2 (8X.7HDENSITY)  , / IX) 


2002  FORMAT 

2003  FORMAT 
1 

2 

3 

2004  FORMAT 

2005  FORMAT 

. 36H 

. 36H 

. 36H 

36H 


(8X,  I5,E15-1*.F15.1*.2E15.1*) 

(///  26H  BEAM  GEOMETRIC  PROPERTIES,  //  5X.7HSECTI0N.3X, 
10HAXIAL  AREA, 2 (3X, 10HSHEAR  AREA) ,6X, 7HT0RS I ON , 2 (6X , 

7H INERT  I A) ,/  6X,6HNUMBER,9X,4HA(1) ,9X,4HA(2) ,9X,4HA(3) , 
9X.4HJ (1) ,9X,4HI  (2) ,9X,4HI  (3) , / IX) 

(7X,  1 5 , 6E 1 3 • ^+) 

(34H13  / D BEAM  ELEMENTS,/// 

NUMBER  OF  BEAMS  =,15/ 

NUMBER  OF  GEOMETRIC  PROPERTY  SETS*, 15/ 

NUMBER  OF  FIXED  END  FORCE  SETS  = J5/ 

. ;un  NUMBER  OF  MATERIALS  =J5) 

2006  FORMAT  (///25H  ELEMENT  LOAD  MULTIPLIERS  / 20X, 1 HA, 1 4X , 1 HB , 1 4X , 1 HC , 

1 1 4X , 1 HD , /6H  X-DIR4E15.8/  8H  Y-D I R4E 1 5 - 6/  6H  Z-D 1 R4E 1 5 - 6/  ) 

2010  FORMAT  (1H1 , 1H  , 

1 '30X40H  FIXED  END  FORCES  IN  LOCAL  COORDINATES  1 

2//'53H  TYPE  NODE  FORCE  X FORCE  Y FORCE  Z ', 

3 ' 35H  MOMENT  X MOMENT  Y MOMENT  Z 1 ) 

2011  FORMAT  (1H  , I 3 . 6X , 1 H I , 3X , 6F 1 2 . 3/ 1 H , 9X, 1HJ , 3X, 6F 1 2 . 3/) 

2013  FORMAT  (1  HO/ 

1 60H  SECTION  PROPERTIES  OTHER  THAN  SHEAR  AREAS  MAY  NOT  BE  SPECIF 

2 34HIED  AS  ZERO.  EXECUTION  TERMINATED.) 

3000  FORMAT  (1015.216, 1 8) 

(22H13/D  BEAM  ELEMENT  DATA,  ///  3X, 4HBEAM, 3 (3X , 4HN0DE) , 3X , 
8HMATERI AL,3X,7HSECTION,3X, 17HELEMENT  END  LOADS, 3X, 

9HEND  CODES,  / 7H  NUMBER, 5X , 2H- I ,5X, 2H-J , 5X, 2H-K, 1 X , 

2 (4X , 6HNUMBER)  , 4X , 1 HA , 4X , 1 HB , 4X , 1HC , 4X, 1 HD ,4X , 2H- I , 4X , 
2H-J,  / IX) 

(4  (2X , 1 5) ,6X, 1 5,5X, 1 5.4 1 5. 2 1 6) 

(9H0BEAM  NO  ,15,  26H  K NODE  ON  BEAM  X-AXIS  , 

. 26H EXECUTION  TERMINATED  ) 

4003  FORMAT  (36HOELEMENT  CARD  ERROR,  ELEMENT  NUMBER*  1 6) 

4004  FORMAT  ( 1 H , 3 1 HNODAL  POINT  NUMBERS  FOR  ELEMENT, 1 5, ' 36HARE  IDENTCAL 
1 EXECUTION  TERMINATED.') 

4005  FORMAT  (8H0ELEMENT, 15, 39H  HAS  ZERO  LENGTH.  EXECUTION  TERMINATED.) 
END 

c MMMMMMMMMMMMM  ax i symmetr i c element  (should  be  deleted  later) 


4000  FORMAT 
1 

2 

3 

4 

4001  FORMAT 

4002  FORMAT 


SUBROUTINE  ELAW  (NUMTC, EE , E , C . P , ALP) 

C 

C CALLS?  POSINV 

C CALLED  BY?  PLNAX 

C 

COMMON  /JUNK/  MAT, NT, TEMP, REFT, BETA, TAU  (4) ,D  (4,4) ,CC  (4,4) 
1 ,XX(4)  , IFILL1  (342) 

COMMON  /ELPAR/  NPAR  (14)  , I F I LL2  (10) 

DIMENSION  E (NUMTC, 11,1) , EE  ( 1 0) , C (4 , 4) , P (4) , ALP  (4) 

C 

C STRESS-STRAIN  LAW  IN  N-S-T  SYSTEM 

C 
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IF  (NT.NE.l)  GO  TO  220 
DO  210  KK* 1 , 10 
210  EE  (KK) “E  ( 1 , KK+1 , MAT) 

GO  TO  260 
220  DO  230  I -2, NT 
Tl-E (1-1 , 1 , MAT) 

T2-E (I , 1 .MAT) 

I F (T2 .GE .TEMP)  GO  TO  240 
230  CONTINUE 
240  CONTINUE 

R I * (T2-TEMP)  / (T2-T1 ) 

RJ=  (TEMP-T1)  / (T2-T1) 

DO  250  KK-1 , 10 

250  EE  (KK) =E  (I -1 , KK+1 .MAT) *RI+E  (I ,KK+1 .MAT) *RJ 
260  CONTINUE 

DO  265  I 1 = 1,4 
DO  265  KK- 1 ,4 
C(l  I ,KK)«0. 

265  D (I  I , KK) =0. 

C 

c (1  , 1)  = 1.0/  EE  (1) 

C (2 , 2)  = 1.0/  EE  (2) 

C (3.3)  “ 1.0/  EE  (3) 

C (1  ,2)  = -EE  (4)  /EE  (2) 

C (1 , 3)  = -EE  (5) /EE  (3) 

C (2 , 3)  = "EE  (6)  /EE  (3) 

C (2 , 1 ) = C (1 , 2) 

C(3.1)«  C (1 ,3) 
c (3.2)  - c (2 , 3) 

C (4,4)  = 1.0/  EE  (7) 

C 

DO  270  M= 1 , 3 
ALP  (M)  - EE (M+7) 

270  CONTINUE 

ALP  (4)  = 0.0 
C 

C ROTATE  MATERIAL  PROPERTIES  TO  R-Z-T  SYSTEM 

C 

I F (BETA. EQ. 0.0)  GO  TO  500 
ANG-BETA/57. 2957795 
SS=S I N (ANG) 

ACC-COS  (ANG) 

S2=SS*SS 

C2=ACC*ACC 

SC-SS*ACC 

C SET  D FOR  SIG(0)»D*SIG(G) 

D (1 , 1)-C2 
D (1  ,2)«S2 
D (1 ,4)  =2.*SC 
D (2, 1) =S2 
D (2 , 2)  =C2 
D (2,4)  =-D  (1 ,4) 

D (3.3)  =1  .0 
D (4,  1)— SC 
D (4,2)  =-D  (4,1) 
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D(4,4)=C2-S2 

C 

C FORM  (D) TRANSPOSE  * (0 

C 

DO  300  1—1,4 
DO  300  J=1 ,4 
SUMO . 

DO  280  M-1,4 

280  SUM=SUM+D  (M, I ) *C  (M, J) 

300  CC  (I , J) =SUM 
C 

C FORM  (D)  TRANSPOSE  * (C)  * (D) 

C 

DO  350  1=1,4 
DO  350  J=l ,4 
SUMO. 

DO  330  M=1 , 4 

330  SUM=SUM+CC  ( I , M) *D  (M, J) 

C (I  , J)  =SUM 
350  C (J , I ) =SUM 
C 

C TRANSFORM  THERMAL  EXPANSION  COEFFICIENTS 
C 

XX  (1)  =C2*ALP  (1)+S2*ALP  (2) 

XX  (2)=S2*ALP  ( 1 ) +C2*ALP  (2) 

XX  (3)  =ALP  (3) 

XX  (4)  =2 . *SC*  (ALP  (1)  -ALP  (2) ) 

DO  430  1=1,4 
430  ALP  ( I ) = XX  (1 ) 

C 

C INVERT  THE  STRAIN-STRESS  LAW 

C 

500  CALL  POSINV  (C.4,4) 

C 

C MODIFY  FOR  THE  CONDITION  OF  PLANE  STRESS 
C 

IF  (NPAR  (5)  .NE.2)  GO  TO  660 
C 

C (1 , 1)  = C (1 , 1)  - C (3*  1)  * c(l, 3) /C  (3, 3) 

C (1 , 2)  = C (1 , 2)  - C (3. 2)  * C (1,3) /C  (3.3) 

C (1 ,4)  = C (1 , 4)  - C (3,4)  * C (1 , 3)  /C  (3,3) 

C (2 , 2)  = C (2,2)  - C (3, 2)  * C (2,3)  /C  (3.3) 

C (2 , 4)  = C (2 , 4)  - C (3,4)  * C(2,3)/C(3,3) 

C (4,4)  = C (4,4)  - C (3,4)  * C (4,3)  /C  (3.3) 

C 

DO  650  1=1,4 
DO  600  J=l ,4 
600  C(J,  l)=C(l  ,J) 

C ( I , 3)  *0 . 

650  C (3, I) =0. 

C 

C RESTRAINED  THERMAL  STRESSES 
C 


660  DO  670  1=1,4 
P(l)  = 0. 
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DO  670  M-1,4 

670  P(l)-P(l)+C(l  , M)  *ALP  (M) 

C 

700  RETURN 
END 

SUBROUTINE  CROSS(A,B,C) 

C 

C CALLED  BY?  PLNAX 
C 

DIMENSION  A (4)  ,B(4)  ,C(4) 

X=A  (2)  *B  (3)  ~A  (3)  *B  (2) 

Y-A(3)*B(1)-A(1)*B(3) 

Z=A  (1)  *B  (2)  -A  (2)  *B  (1) 

C (4) =SQRT (X*X+Y*Y+Z*Z) 

C (3)  *Z/C  (A) 

C (2)  -Y/C  (A) 

C (1)  -X/C  (4) 

RETURN 

END 

SUBROUTINE  FORMB  (S,T,B) 

C 

C CALLED  BY?  QUAD 
C 

COMMON  /ELPAR/  NPAR  ( 1 4)  , NUMNP , MBAND , NELTYP , N 1 , N2 , N3 , N4 , N5 , MTOT , NEQ 
COMMON  /EM/  LM ( 1 2) , U ( 1 2 , 1 2) , P ( 1 2 , 4) , XM  ( 1 2) , 

1 T I (20,4)  , I X (4)  , I E (5)  , NS , D (A , A)  , EMUL  (4 , 5)  ,RR(4)  ,ZZ(4)  ,H(6)  ,HS(6)  , 

2 HT  (6)  , HR  (6)  , HZ  (6)  ,FAC,  XMM,  PRESS , EE  (10)  ,TTI  (4)  , PP  (1 2 , 4)  ,TH  I CK 

3 ,TMP  (4)  , QP  (1  2)  , ALP  (4)  , I F I LL2  (4236) 

DIMENSION  B (20,12) 

DIMENSION  I I (6)  ,JJ  (6) 

DATA  I l/l,2,3,4,9.10/,JJ/5,6,7.8,ll,12/ 

C 

SM- 1 .0-S 
SP-1 .0+S 
TM- 1 .0-T 
TP-1 .0+T 
C 

H (1) -SM*TM/4. 

H (2) =SP*TM/4 . 

H (3) =SP*TP/4. 

H (4) =SM*TP/4 . 

H(5)-(1.0-S*S) 

H (6)  - ( 1 .0-T*T) 

C 

HS(1)— ' TM/4. 

HS  (2)— HS  (1) 

HS  (3) “TP/4 . 

HS  (4)  — HS  (3) 

HS  (5)— 2.*S 
HS (6) -0.0 

HT(1)— SM/4. 

HT  (2)  — SP/4 . 

HT  (3)  — HT  (2) 

HT  (4)  — HT  (1) 


C 


o r>  o 
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HT  (5)  =0.0 
HT  (6)=-2.*T 
C 

PZT=HT  (1)  *ZZ  ( 1)  +HT  (2)  *ZZ  (2)  +HT  (3)  *11  (3)  +HT  (4)  *11  (4) 

PZS=HS  (1)  *ZZ  (1)+HS  (2)  *11  (2)  +HS  (3)  *11  (3)  +HS  (4)  *ZZ  (4) 

PRS=HS  (1)  *RR  (1)+HS  (2)  *RR  (2)  +HS  (3)  *RR  (3)+HS  (4)  *RR  (4) 

PRT=HT  ( 1 ) *RR  ( 1 ) +HT  (2)  *RR  (2)  +HT  (3)  *RR  (3)  +HT  (4)  *RR  (4) 
XJ=PRS*PZT-PRT*PZS 
C 

PSR=PZT/XJ 

PTR=-PZS/XJ 

PSZ=-PRT/XJ 

PTZ=PRS/XJ 

C 

DO  100  1=1,6 

HR ( I ) =PSR*HS  ( I ) +PTR*HT  ( I ) 

100  HZ(I)=PSZ*HS(I)+PTZ*HT(I) 

R=H  (1)  *RR  (1 ) +H  (2)  *RR  (2)  +H  (3)  *RR  (3)  +H  (4)  *RR  (4) 

I F (NPAR  (5)  .NE.O)  R=TH I CK 
C 

C FORM  STRAIN  DISPLACEMENT  MATRIX 
C 

DO  200  K=1 ,6 
1 = 1 I (K) 

J=JJ  (K) 

B ( 1 , I ) =HR  (K) 

B (2 , J)  =HZ  (K) 

C 

C TEST  FOR  HOOP  STRAIN  EVALUATION  (AX I SYMMETR I C SOLID) 

C 

I F (NPAR  (5)  .GT.O)  GO  TO  190 

C SET  HOOP  STRAIN  .EQ.  RADIAL  STRAIN  IF  ON  C/L  AXIS 

IF  (R . LT . 1 .OE-6) 

*B  (3.  I)  =B  (1 , I) 

C 

IF  (R.GT.l.OE-6) 

*B  (3,  D=H  (K)  /R 
C 

190  CONTINUE 

B(4,I)=HZ(K) 

200  B (4 , J)  *HR  (K) 

C 

FAC=XJ*R 
RETURN 
END 

SUBROUTINE  PLNAX  (I D,X,Y,Z,T,NTC,WT,RO,WANG,E,NUMTC,NUMNP,B,BB) 

CALLS?  ELAW, QUAD .VECTOR , CROSS , DOT, CALBAN 
CALLED  BY?  PLANE 
C 

DIMENSION  X(l)  ,Y(1)  ,Z(1)  , ID(NUMNP.l)  , NTC  (1)  ,WT  (1)  ,R0  (1)  ,WANG(1)  , 

1 E (NUMTC , 1 1 , 1)  ,T  (1)  ,B  (20, 12)  ,BB  (20, 12) 

' COMMON  /ELPAR/  NPAR  (1 4) , NUMNN , MBAND , NELTYP , N 1 ,N2,N3»N4,N5.MT0T ,NEQ 
COMMON  /EM/  LM(12)  ,S  (12,  12)  ,P  (12,4)  ,XM(12)  , 

1 T I (20,4)  , IX  (4)  , I E (5)  ,NS,D  (4,4)  ,EMUL(4,5)  ,RR(4)  ,ZZ(4)  ,H  (6)  ,HS  (6)  . 
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2 HT  (6)  , HR  (6)  , HZ  (6)  , F AC , XMM,  PRESS , EE  (10)  ,TTI  (4)  ,PP  (12,4)  .THICK 

3 ,TMP  (4)  , TP  (12)  .ALP  (4)  , I F I LL2  (4236) 

COMMON  /JUNK/  MAT, NT, TEMP , REFT, BETA , U (4)  , V (4)  ,W(4)  ,G (4)  , I FLL (390) 
COMMON  /EXTRA/  M0DEX.NT8, I F I LL3 (14) 

common  /say/  neqq , numee, 1 oopur , nnb 1 ock , nterms.opt i on 
common  /what/  naxa  (10000) , i rowl  ( 10000) , i col h (10000) 

C 

NUME-NPAR  (2) 

NUMMAT-NPAR (3) 
numee-nume 
neqq=neq 

WRITE  (6,2000)  (NPAR(M)  ,M-2,6) 

C 

C READ  AND  PRINT  OF  MATERIAL  PROPERTIES 
C 

DO  60  M-l.NUMMAT 

READ  (5,1010)  MAT.NTC  (MAT)  ,WT  (MAT) ,R0 (MAT) .WANG (MAT) 

IF  (NTC  (MAT)  .EQ.O)  NTC  (MAT) =1 
WRITE  (6,2020)  MAT.NTC  (MAT)  ,WT  (MAT) ,R0 (MAT) .WANG  (MAT) 

NT=NTC  (MAT) 

READ  (5,1005)  ( (E  ( I , J , MAT) ,J=1,11),I=1, NT) 

WRITE  (6,2010)  ( (E  ( I , J , MAT) , J=1 , 1 1) , I =1 ,NT) 

60  CONTINUE 

C***  DATA  PORTHOLE  SAVE 

I F (MODEX.EQ.O)  GO  TO  75 
DO  70  M*1 .NUMMAT 

WRITE  (NT8)  M, NTC  (M)  ,WT(M)  , WANG  (M) 

NT  * NTC  (M) 

WRITE  (NT8)  ((E(I,J,M)  ,J-1,11)  ,1  = 1, NT) 

70  CONTINUE 
75  CONTINUE 
C 

C ELEMENT  LOAD  CASE  MULTIPLIERS 
C 

READ  (5,1002)  ((EMUL(I.J)  ,J=1,5)  ,1  = 1,4) 

WRITE  (6,2004)  ((EMUL(I,J) ,J=1,5) ,1=1,4) 

C***  DATA  PORTHOLE  SAVE 
I F (MOOEX.EQ, 1) 

ftWRITE  (NT8)  ((EMUL(I.J)  ,J-1,5)  , 1-1.4) 

C 

C READ  AND  PRINT  OF  ELEMENT  PROPERTIES 

C 

WRITE  (6,2002) 

N-0 

130  READ  (5. 1003)  M,  (IE  (I) , 1-1 ,5) , REFT, PRESS, NS, KG, THICK 
MAT- IE  (5) 

IF  (KG. EQ.O)  KG-1 
IF  (NPAR  (5)  . EQ. 1)  THICK-1 .0 
IF  (NS. EQ.O)  NS-4 
I F (NS . LT.4)  NS-1 

I F ( ( I E (3)  . EQ. I E (4) ) .AND.  (NS.EQ.20)  ) NS-16 
140  N-N+l 

IF  (M.EQ.N)  GO  TO  145 
DO  142  1=1,4 
142  I X ( I ) - 1 X ( I ) +KG 
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GO  TO  149 
145  DO  148  1=1,4 

148  I X ( I ) *1 E ( I ) 

C 

C FORM  CONSTITUTIVE  LAW  AND  COMPUTE  THERMAL  STRESSES 

C 

149  NT=NTC  (MAT) 

WRITE  (6,2003)  N, IX, MAT, REFT, PRESS, NS, KG, THICK 
C***  DATA  PORTHOLE  SAVE 

IF (MODEX.EQ.O)  GO  TO  150 

WRITE  (NT8)  N, IX, MAT, REFT, PRESS, NS, THICK 

GO  TO  153 

150  CONTINUE 
l = IX(l) 

J=  I X (2) 

K=IX(3) 

L=  I X (4) 

TEMP  = (T  (l)+T  (J)+T  (K)+T  (L) ) /4.0 
BETA=WANG  (MAT) 

XMM=RO (MAT) 

WGT=WT  (MAT) 

CALL  ELAW  (NUMTC , EE , E , D , TT I , ALP) 

C 

C CALCULATE  ELEMENT  STIFFNESS  MATRIX 
C 

153  I F (NPAR  (1)  . EQ.  3)  GO  TO  160 
ND=8 

DO  155  1-1,4 
I I = I X ( I ) 

RR  ( I ) =Y  ( I I ) 

ZZ(I)=Z(I  I) 

TMP ( I ) = T ( I I ) 

LM  ( I ) = I 0 (I  I ,2) 

155  LM  ( I +4)  = I D ( I 1 ,3) 

I F (MODEX.EQ. 1)  GO  TO  300 
C 

CALL  QUAD  (B , BB) 

C 

DO  158  1=1,4 
DO  157  L* 1,4 

P ( I , L) =P ( I , L) +XM ( I ) *WGT*EMUL  (L , 4) 

157  P (1+4,  L)  =P  (l+4,L)+XM  (I)  *WGT*EMUL  (L,5) 

XM  ( I ) =XM ( I ) *XMM 

158  XM  (1+4)  =XM  ( I ) 

GO  TO  300 

C 

160  ND  = 12 

IF (MODEX.EQ. 1)  GO  TO  1 65 

CALL  VECTOR  (V,X  (I ) , Y ( I ) , Z ( I ) , X (J)  , Y (J)  ,Z  (J) ) 

CALL  VECTOR  (G.X  (I ) ,Y  (I)  ,Z  (I)  ,X  (L)  ,Y  (L)  ,Z  (L) ) 

CALL  CROSS  (V.G.W) 

CALL  CROSS (W.V.U) 

CALL  VECTOR  (W,  X ( I ) , Y ( I ) , Z ( I ) , X (K)  , Y (K)  , Z (K) ) 

RR  (1)  =0.0 
ZZ  (1)=0.0 
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RR  (2)  -V  (4) 

ZZ  (2)  *0 . 0 

RR  (3)  -W  (It)  *DOT  (W,V) 

ZZ(3)-W(4)  *DOT  (W,U) 

RR(4)  «G(4)ftD0T(G,V) 

ZZ  (4)  =G  (4)*D0T  (G.U) 

C 

165  DO  170  1*1,4 
I 1 = 1 X (I) 

TMP(I)  = T(l  I) 

LM  (I ) *1 D (I  I , 1) 

LM  (1+4)  = 1 D (I  I ,2) 

170  LM  (1+8)  = I D ( I I ,3) 

I F (MODEX.EQ. 1)  GO  TO  300 
C 

CALL  QUAD  (B.BB) 

C 

. DO  190  1*1,3 
DO  190  K=1 ,4 
KK=4*  (l-D+K 
DO  180  L=1 ,4 

1 80  PP  (KK , L)  -V  ( I ) *P  (K , L)  +U  ( I ) *P  (K+4 , L) 

DO  190  J-l ,3 
DO  190  L*1 ,4 
LL=4*  (J-D+L 

190  BB  (KK,  LL)=V(I)  * (S  (K.L)  ftV(J)+S  (K , L+4)  *U  (J) ) 

1 +U  ( I ) * (S  (K+4 , L)  >W  (J)  +S  (K+4 , L+4)  *U  (J) ) 

C 

DO  196  1*1,12 
DO  194  L= 1 , 4 
194  P(l  ,L)-PP(I  ,L) 

DO  196  J= I , 1 2 
S ( I , J) *BB  ( I , J) 

196  S (J,  I)  =S  (I  , J) 

C 

DO  210  K= 1 , NS 
DO  200  L= 1 , 4 
DO  200  J*1 , 3 
LL*4*  (J-l)+L 

200  BB  (K , LL)  =B  (K , L)  *V  (J)  +B  (K , L+4)  *U  (J) 

DO  210  J=1 , 12 
210  B (K, J) *BB  (K, J) 

C 

DO  220  1*1,4 
DO  215  L-1,4 

P(l  , L)  -P  ( I ,L)+XM(I)  ftWGT*EMUL  (L,3) 

P ( I +4 , L) -P ( I +4 , L) +XM  ( I ) *WGT*EMUL  (L , 4) 

215  P ( I +8 , L) -P  ( I +8 , L) +XM  ( I ) *WGT*EMUL  (L , 5) 

XM  ( I ) *XM ( I ) *XMM 
XM  (1+4)  «XM  ( I ) 

220  XM  (1+8)  -XM  ( I ) 

C 

C CALCULATION  OF  BAND  WIDTH  AND  WRITES  ELEMENT  MATRICES  ON  TAPES 
C 

300  CALL  CALBAN  (MBAND ,ND I F , LM, XM, S, P,ND , 1 2 , NS) 
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I F (MODEX.EQ. 1)  GO  TO  310 

WRITE  (1)  ND.NS,  (LM(I)  , 1 = 1, ND)  , ((  B(l  ,J)  , 1 = 1 ,NS)  .J-l.ND)  , 
1 ( (T I ( I i J)  , I = 1 , NS)  , J=  1 , 4) 

310  I F (N . EQ.NUME)  RETURN 
IF  (N.EQ.M)  GO  TO  130 
GO  TO  140 


1002  FORMAT  (5F10.0) 

1003  FORMAT  (615. 2F10. 0,215. F10.0) 

1005  FORMAT  (8F10.0/3F10.0) 

1010  FORMAT  (2 1 5. 3F 10.0) 

2000  FORMAT  (//  23H  NUMBER  OF  ELEMENTS 

1 23H  NUMBER  OF  MATERIALS 

2 23H  MAXIMUM  TEMPERATURES 

3 2 3H  PER  MATERIAL 

L 23H  ANALYSIS  CODE 

5 23H  CODE  FOR  INCLUSION 

6 23H  OF  BENDING  MODES 

7 23H  EQ.O,  INCLUDE 

8 23H  GT.O,  SUPPRESS 


l6  / 

16  / 

/ 

1 6 / 

16  / 

/ 

16  / 

/ 

////  IX) 


1 

2 

3 


2003 

2004 


1 

2 

3 

4 


2010 

2020 


2002  FORMAT  (8H 1 ELEMENT , 26X , 4HMATL , 5X , 9HREFERENCE , 3X ,8H I -J  FACE.3X, 
6HSTRESS,  / 2X.6HNUMBER.5X, 1HI ,5X, 1HJ.5X, 1HK.5X, 1HL.2X, 
4HTYPE , 3X , 1 1 HTEMPERATURE , 3X , 8HPRESSURE , 3X , 6H0PT I ON , 4X , 
2HKG.3X.9HTHICKNESS,  / IX) 

FORMAT  (|8,5I6,F14.3,E11.3.I9,I6,F12.4) 

FORMAT  (///  25H  ELEMENT  LOAD  MULTIPLIERS,  //  10H  LOAD  CASE , 4X , 

1 1 HTEMPERATURE, 3X.8HPRESSURE, 3X.9HX-GRAV I TY.3X, 

9HY-GRAVI TY , 3X , 9HZ-GRAV I TY , //  5X, 1HA.F 19.3.F 1 1 . 3. 3F 1 2 .3  / 
5X, 1HB.F19.3.F1 1 .3.3F12.3  / 5X. 1HC.F19-3.F1 1 -3.3F12.3  / 

5X, 1HD,F19-3.F1 1 -3.3F12.3  ) 

FORMAT  (F 12.2,3E12.4,3F9-4,E12.4,3E14.4) 

FORMAT  (///  25H  MATERIAL  I.D.  NUMBER  =,  15  / 

25H  NUMBER  OF  TEMPERATURES  *,  15  / 

25H  WEIGHT  DENSITY  =,  E14.4  / 

25H  MASS  DENSITY  =,  E14.4  / 

25H  BETA  ANGLE  F9-3  //  , x 

12H  TEMPERATURE, 8X.4HE  (N) ,8X,4HE  (S) ,8X,4HE  (T) ,3X,6HNU  (NS) , 
3X,6HNU(NT)  ,3X,6HNU(ST)  ,7X,5HG(NS)  ,6x,8halpha  (N)  ,6x, 
8HALPHA  (S) .6X.8HALPHA  (T)  ) 

END 

SUBROUTINE  QUAD  (B.BB) 

CALLS?  FORMB, VECTOR 
CALLED  BY?  PLNAX 

COMMON  /ELPAR/  NPAR(l4) .NUMNP.MBAND.NELTYP.NI ,N2,N3,N4,N5,MT0T,NEQ 
COMMON  /EM/  LM  (1 2)  , S (1 2 , 1 2)  , P (1 2 , 4)  ,XM  (1 2)  , 

1 T I (20,4)  , I X (4)  , I E (5)  »NS,D  (4,4)  ,EMUL(4,5)  .RR(4)  ,ZZ(4)  ,H(6)  ,HS(6)  , 

2 HT  (6)  ,HR(6)  , HZ  (6)  , FAC,  XMM,  PRESS,  EE  (10)  ,TTI  (4)  ,PP  (12,4)  .THICK 

3 ,TMP  (4)  , TP  (12)  ,ALP(4)  ,IFILL2  (4236) 

COMMON  /JUNK/  MAT, NT, TEMP .REFT, BETA , I F I LL1 (422) 

DIMENSION  B(20, 12)  ,BB(20, 12) 

DIMENSION  SS  (2)  ,TT(2)  , HH  (2)  ,SSS(5)  ,TTT  (5)  , I VECT  (4)  ,JVECT(4)  ,V(4) 
DATA  SSS/O. ,-l . , 1 . ,0. ,0./,  TTT/O. ,0. ,0. ,-l . , 1 ./ 

DATA  SS/-0. 577350269 18963, 0.577350269 18963/ 


1 

2 

3 

4 

5 

6 
7 


C 

C 

C 

C 
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DATA  TT/-0. 577350269 18963, 0.577350269 18963/ 

DATA  HH/1  . , 1 ./,  IVECT/4,2, 1 ,3/,  JVECT/1  , 3,2,1*/ 

C 

DO  170  J=1 ,12 
XM  (J)  =0.0 
TP  (J)  - 0.0 
DO  160  1=1,20 
BB (I , J) =0.0 
160  B ( I ,J)=0.0 
DO  170  1=1,12 

170  S (I , J) =0.0 

C 

DO  500  11=1,2 
DO  500  JJ=1 ,2 

CALL  FORMB  (SS  (I  I)  ,SS  (J  J)  , B) 

TEMP  = 0.0 
DO  200  1=1,4 

200  TEMP  = TEMP  + H(l)*  TMP(I) 

FAC=FAC*HH  (JJ) *HH  (II) 

FTP  = TEMP  - REFT 
DO  400  J=1 , 12 

D1=  (D  (1 , 1)  *B  (1 , J)+D  (1 ,2)  *B  (2,  J)+D  (1 ,3)  *B  (3,  J)+D  (1 ,4)  *B  (4,  J) ) *FAC 
D2=(D(2,1)*B  ( 1 , J)  +D  (2 , 2)  *B  (2 , J)  +D  (2,3)  *B(3.J)+D  (2 , 4)  *B  (4 , J) ) *F AC 
D3=  (D  (3 , 1 ) *B  ( 1 , J)  +0  (3 , 2)  *B  (2 , J)  +D  (3 , 3)  *B  (3 , J)  +D  (3 , 4)  *B  (4 , J) ) *F  AC 
D4=(D(4,1)*B(1,J)+D  (4,2)  *B  (2,  J)+D  (4,3)  *B(3.J)+D  (4,4)  *B  (4,J))*FAC 
TP  (J)  = TP  (J)  + FTP*  (D 1 *ALP  ( 1 ) +D2*ALP  (2)  + D3*ALP  (3)  + D4*ALP  (4) ) 
DO  400  I =J, 12 

S ( I , J)  =$  ( I , J)  +B  (1 , I ) *D  1+B  (2 , I ) *D2+B (3,1)  *D3+B (4,1)  *04 
400  S (J  , I ) =S  ( I , J) 

DO  450  1=1,4 
450  XM(I)=XM(I)+FAC*H(I) 

500  CONTINUE 
C 

C FORM  STRESS  D I SDLACEMENT  MATRIX 
C 

LL=NS/4 
DO  530  L=1 , LL 

CALL  FORMB  (SSS  (L)  ,TTT(L)  , BB) 

C 

TEMP  = 0.0 
DO  515  K™ 1,4 

515  TEMP  = TEMP  + H (K)  * TMP  (K) 

FAC  = TEMP  - REFT 
DO  530  I 1 = 1,4 
1 = 1 1+4*  (L  - 1) 

T I (1,4)  = -TTI  (I  I)*  FAC 
DO  530  J-l, 12 
B (I , J) =0.0 
DO  530  K=1 , 4 

530  B ( I , J)  =B  ( I , J)  +D  ( I I , K)  *BB  (K , J) 

C 

C ELIMINATE  EXTRA  DEGREES  OF  FREEDOM 
C 

I F ( IX  (3)  . EQ . I X (4)  ) GO  TO  560 
I F ( NPAR(6) .NE.O  ) GO  TO  56O 
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00  550  NN-1,4 
L= 1 2-NN 
K=L+1 

C = TP(K)/S(K,K) 

DO  535  J*1.NS 

535  T I (J,4)  = T I (J,4)  + C*  B (J  , K) 

DO  550  1-1, L 
OS  (I  ,K)/S(K,K) 

TP  (I ) = TP  ( I ) " C*  TP  (K) 

DO  540  J-l.NS 

540  B(J,I)=B(J,I)-C*B(J,K) 

DO  550  J-l.L 

550  S (I  , J)  =S  ( I ,J)-C*S(K,J) 

C 

c ROTATE  STRESS-DISPLACEMENT  TRANSFORMATION  TO  GIVE  STRESSES 

C NORMAL  AND  PARALLEL  TO  SIDES.  SIMILARLY,  ROTATE  INITIAL  STRESSES. 

C 

560  NSET  = LL-1 

I F ( NSET. LE .0  ) GO  TO  730 
DO  720  L=1 , NSET 
IV  = IVECT(L) 

JV  = JVECT(L) 

CALL  VECTOR  (V, RR  ( I V)  , ZZ  ( I V)  ,0 .0 , RR  (JV)  , ZZ  (JV)  ,0 .0) 

S2  * V (1)  *V  (1) 

C2  = V(2)*V(2) 

SC  — V (1)  *V  (2) 

I 1 = 4*L+1 
12  = 11+1 
14  = 11+3 
T 1 = T I (11,4) 

T2  = T I (12,4) 

T4  = T I (14,4) 

T5  = 2.0*SC*T4 

T I (11,4)  = C2*T1+S2*T2+T5 

Tl  (12,4)  = S2*T1+C2*T2-T5 

T I (14,4)  = SC*(T2-T1)  + (C2-S2)*T4 

DO  710  J=1 ,8 

B 1 = B (I  1 , J) 

B2  = B ( I 2 , J) 

B4  = B (I  4,  J) 

B5  * 2 .0*SC*B4 
B ( I 1 , J)  * C2*B1+S2*B2+B5 
B ( I 2 , J)  - S2*B1+C2*B2-B5 

710  B (I  4, J)  = SC*  (B2-B 1)  + (C2-S2) *B4 

720  CONTINUE 

730  CONTINUE 
C 

DO  660  L=1 ,4 
DO  600  1=1, NS 

600  Tl  (I  ,L)  = Tl  (1,4)*  EMUL(L.l) 

DO  660  1=1,8 

660  P(l  ,L)  = TP(I)*  EMUL(L.l) 


C 

C 

C 
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DR=RR  (2)  -RR  (I) 

DZ-ZZ(l)  -ZZ(2) 

R I -PRESS*  (2  . *RR  (1)  +RR  (2) ) /6 . 

RJ-PRESS*  (2 . *RR  (2) +RR (1) ) /6. 

I F (NPAR  (5) .EQ.O)  GO  TO  670 
R I =PRESS*TH I CK/2 . 

RJ-RI 

670  DO  700  L-1,4 

P(1  ,L)-P(1,L)+DZ*RI*EMUL  (L,2) 

P (5 , L)  -P  (5 . L)  +DR*R  I *EMUL  (L , 2) 

P (2,L)-P  (2 , L)  +DZ*RJ*EMUL  (L,2) 

700  P (6 , L) =P  (6, L) +OR*RJ*EMUL (L,2) 

RETURN 

END 

SUBROUTINE  VECTOR (V, X I , Y I , Z I , XJ , YJ , ZJ) 
C 

C CALLED  BY?  PLNAX.QUAD 
C 

DIMENSION  V (J») 

X=X J-X I 
Y=YJ-Y I 
Z-ZJ-ZI 

V (4) =SQRT  (X*X+Y*Y+Z*Z) 

C 

v (3  )=Z/V(4) 

V (2)  =Y/V  (4) 

V(1)=X/V(4) 

RETURN 

END 

SUBROUTINE  POS I NV  (A.NMAX.NDD) 

C 

C CALLED  BY?  ELAW 
C 

DIMENSION  A (NDD , NDD) 

C 

DO  200  N* 1 , NMAX 
C 

D=A  (N , N) 

DO  100  J-l.NMAX 
IF  (D.EQ.O.) D=0 .005 
100  A (N,  J)  —A  (N,  J)  /D 
C 

DO  150  1-1, NMAX 
IF(N-I)  110,150,110 
1 10  DO  140  J-l.NMAX 

IF(N-J)  120,140,120 
120  A (I  , J)  -A  (I  , J)+A  (I  ,N)  *A  (N,  J) 

140  CONTINUE 
150  A (I  ,N)-A(I,N)/D 
C 

A (N , N)  -1  .0/D 
C 

200  CONTINUE 
C 


RETURN 
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END 

FUNCTION  DOT  (A , B) 

C 

C CALLED  BY?  PLNAX 

C 

DIMENSION  A (4)  ,B  (4) 

DOT=A  (1)  *B  (1)  +A  (2)  *B  (2)  +A  (3)  *B  (3) 

RETURN 

END 

SUBROUTINE  PLANE 
C 

C CALLS?  PLNAX, STRSC 

C CALLED  BY?  ELTYPE 

C 

COMMON  /one/  A(l) 

COMMON  /ELPAR/  NPAR(l4) ,NUMNP,MBAND,NELTYP,N1 ,N2,N3,N4,N5,MTOT,NEQ 
COMMON  /EM/  NS,ND,B(42,63)  .Tl  (42,4)  ,LM(63) 

COMMON  /JUNK/  LT , LH , L , I PAD , SG  (20) , S I G (7) ,EXTRA(150) , N6 , N7 , N8 , N9 , 

1 N10,N11,N12,IFILL(65) 

COMMON  /EXTRA/  M0DEX,NT8,N10SV,NT10, I F I LL2 (12) 
common  /say/  neqq , numee, 1 oopur , nnb 1 ock , nterms ,opt i on 
common  /what/  naxa  (1 0000) , i rowl  ( 1 0000) , i col h (10000) 

DIMENSION  STRLAB  (5) 

DATA  STRLAB/3HCEN.3HL-I , 3HJ-K, 3H I -J , 3HK-L/ 

C 

IF  (NPAR(l)  . EQ.O)  GO  TO  200 
IF  (NPAR(l)  . EQ.  3)  NPAR(5)«2 
IF  (NPAR(5)  .EQ.O)  WRITE  (6,2000) 

IF  (NPAR(5)  -EQ.  1)  WRITE  (6,2001) 

I F (NPAR  (5)  • EQ. 2)  WRITE  (6,2002) 

IF  (NPAR  (1)  - EQ.  3)  WRITE  (6,2003) 

IF  (NPAR  (6)  .NE.O)  WRITE  (6,2004) 

I F (NPAR  (3)  -EQ.O)  NPAR  (3)  =1 
IF  (NPAR  (4)  .EQ.O)  NPAR  (4)  =1 
N6-N5+NUMNP 
N7=N6+NPAR (3) 

N8=N7+NPAR(3) 

N9=N8+NPAR (3) 

N10-N9+NPAR (3) 

N 1 1=N10+1 1*NPAR (4) *NPAR (3) 

N12-N1 1+240 

MM“N 1 2+240-MT0T 

I F (MM.GT.O)  CALL  ERROR (MM) 

C CALL  PLNAX(A(N1)  ,A(N2)  ,A(N3)  ,A(N4)  ,A(N5)  ,A(N6)  ,A(N7)  ,A(N8)  , 

1 A(N9)  , A (N10)  , NPAR  (4)  , NUMNP.A  (Nil)  ,A(N12)) 

C 

RETURN 

C 

200  WRITE  (6,2006) 

NUME=NPAR  (2) 

DO  800  MM=1 ,NUME 

CALL  STRSC  (A  (Nl)  ,A  (N3)  ,NEQ,0) 

C***  STRESS  PORTHOLE 
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IF  (N10SV.EQ.  1) 

*WR I TE  (NT  10)  NS 
I F (NS.EQ. 1)  GO  TO  800 
WRITE  (6,3000)  MM 
DO  700  L=LT,LH 

CALL  STRSC  (A  (Nl)  ,A  (N3)  ,NEQ,  1) 

I TAG  = 0 

510  DO  600  KK-1 , NS , 4 
I TAG  = I TAG  + 1 
DO  520  1=1,4 
I I =KK- 1 + 1 

520  S I G ( I ) =SG  (II) 

CC-(SIG(l)+SIG(2))/2.0 
BB=  (SIG  (1)  -SIG  (2))/2. 

CR=SQRT (BB**2+S I G (4) **2) 

S I G (5)  =CC+CR 
SIG(6)=CC-CR 
S I G (7) *0.0 

I F ( (BB.EQ.O.O)  .AND.  (SIG  (4)  .EQ.O.O) ) GO  TO  530 
S I G (7) =28 . 648*ATAN2 (S I G (4) , BB) 

C***  STRESS  PORTHOLE 
530  I F (N10SV.EQ. 1) 

*WR I TE  (NT10)  MM, L,  (SIG  (I) , 1 = 1 ,7) 

600  WRITE  (6,3001)  L.STRLAB  (ITAG)  , (SIG  (I) , 1=1 ,7) 

WRITE  (6,3002) 

700  CONTINUE 
800  CONTINUE 
RETURN 

2000  FORMAT 

2001  FORMAT 

2002  FORMAT 

2003  FORMAT 

2004  FORMAT 
2006  FORMAT 

1 

2 

3 

4 

3000  FORMAT 
1 

2 

3001  FORMAT 

3002  FORMAT 
END 

subroutine  assm  (a,b, 1 1 ,ntr ,neq) 
common  /say/  neqq.numee, loopur ,nnb lock, n terms, option 
common  /what/  naxa  (10000) , i rowl  (10000) , i col h (10000) 
COMMON  /EM/  LRD,ND,LM(63) , IPAD, SS  (2331) 
dimension  a (ntr) ,b  (neq, 1 1) 
dimension  sd  (24,24) 
neq*neqq 
nume=numee 
do  7 1 i*l , nterms 
71  a (i ) =0 

contribution  from  each  element 


(22H1 AX  I SYMMETRIC  ANALYSIS  ) 

(22H1  PLANE  STRAIN  ANALYSIS  ) 

(22H  1 PLANE  STRESS  ANALYSIS  ) 

(18H  MEMBRANE  ELEMENTS  ) 

(30H  INCOMPATIBLE  MODES  SUPPRESSED  ) 

(54H1T  WO-DIMENSIONAL  FINITE  ELEM, 
8H  E N T S ,///  8X.32H1.  CENTROIO  STRESSES  REFERENCED, 

26H  TO  LOCAL  Y-Z  COORDINATES.,/  8X,  12H2.  MID-SIDE, 

5 1 H STRESSES  ARE  NORMAL  AND  PARALLEL  TO  ELEMENT  EDGES., 

//  IX) 

(10H0ELEMENT  (J5.1H),//  2X,  4HL0AD , 2X,  3HL0C,  1 2X , 3HS 1 1 , 1 2X, 
3HS22, 12X.3HS33, 12X.3HS12, 10X.5HS-MAX, 10X.5HS-MI N,5X, 
5HANGLE,  / IX) 

(I6,2X,A3,6E15.5.F10.2) 

( 1 HO) 


c 
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rewind  14 
rewind  13 
do  72  i =1 1 nume 

read  (14) 1 rd , nd , ( 1 m ( i i) , i i = l , nd) 
read  (13)  ( (sd  (i  i ,jj)  , j j*1  , nd)  , i i = l , nd) 
do  79  j*l *nd 
j j = 1 m ( j ) 

i f (j  j .eq.O)  go  to  79 
do  76  k® 1 , nd 
kk=lm  (k) 

if (kk. eq.O. or. kk.lt. jj)  go  to  76 
1 ocate=naxa  (j j) +kk-j j 
a (locate)  =a  (locate)+sd  (j  ,k) 

76  continue 

79  continue 

72  continue 

return 
end 

SUBROUTINE  ADDSTF  (A , B , STR ,TMASS , NUMEL , NBLOCK , NE2B, LL , MB AND , ANORM, 
1 NVV) 

C 

C 

C CALLED  BY?  MAIN 

C 

c FORMS  GLOBAL  EQUILIBRIUM  EQUATIONS  IN  BLOCKS 

C 

DIMENSION  A (NE2B.MBAND)  ,B  (NE2B.LL)  ,STR(4,LL) .TMASS (NE2B) 

C 

COMMON  /DYN/  NT, NOT, ALFA , DT, BETA , NFN, NGM, NAT, NDYN 
COMMON  /EM/  LRD,ND,LM(63)  . IPAD, SS  (2331) 

COMMON  /EXTRA/  MODE X , NT8 , I F I LL ( 1 4) 

common  /say/  neqq , numee, 1 oopur , nnb 1 ock , nterms ,opt i on 
common  /what/  naxa  ( 10000) , i rowl  (10000) , i col h (IOOOO) 

C 

NEQB=NE2B/2 
K-NEQB+1 
X-NBLOCK 
MB=SQRT  (X) 

MB-MB/2+1 

NEBB=MB*NE2B 

MM-1 

NDEG-0 

NVV“0 

ANORM-O . 

NSHIFT-0 
REWIND  3 
REWIND  4 
REWIND  9 
C 

C READ  ELEMENT  LOAD  MULTIPLIERS 
C 

WRITE  (6,2000) 

DO  50  L=1 , LL 

READ  (5.1002)  (STR  ( I , L)  ,1  = 1,4) 
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50  WRITE  (6,2002)  L,  (STR  (I , L) , 1-1 , 4) 

IF (MODEX.EQ.O)  WRITE  (8)  STR 
C 

C FOR  A STEP-BY-STEP  ANALYSIS  (NDYN.EQ.4)  READ  THE  SOLUTION 

C CONTROL  CARD.  THE  TIME  STEP  (DT)  AND  THE  DAMPING  COEFFICIENTS 

C (ALFA/BETA)  ARE  REQUIRED  FOR  THE  ASSEMBLY  OF  THE  EFFECTIVE 
C SYSTEM  STIFFNESS  MATRIX  IN  THIS  ROUTINE. 

C 

IF  (NDYN.NE.4)  GO  TO  65 
C 

READ  (5,1004)  NFN, NGM, NAT, NT, NOT, DT, ALFA, BETA 
WRITE  (6,2004)  NFN , NGM, NAT, NT, NOT , DT, ALFA, BETA 
I F (NAT.EQ.O)  NAT  = 1 
I F (NOT . EQ.O)  NOT  = 1 
I F (DT.GT. 1 .OE-12)  GO  TO  55 
WRITE  (6,3000) 

STOP 

C 

C COMPUTE  INTEGRATION  COEFFICIENTS  FOR  ASSEMBLY  OF  EFFECTIVE 
C SYSTEM  STIFFNESS  (STEP-BY-STEP  ANALYSIS  ONLY) 

C 

55  TETA  = 1.4 
DTI  - TETA*DT 
DT2  = DT  1 **2 

AO  * (6.+3.*ALFA*DTl) / (DT2+3.*BETA*DT1) 

C 

65  I F (MODEX.EQ. 1)  RETURN 
C 

C FORM  EQUATIONS  IN  BLOCKS  ( 2 BLOCKS  AT  A TIME) 

C 

DO  1000  M=1 , NBLOCK  ,2 
DO  100  1=1 , NE2B 
DO  100  J=1 .MBAND 
100  A ( I , J) =0 . 

READ  (3)  ( (B  ( I , L)  ,1  = 1 , NEQB) , L=1 , LL) , (TMASS  ( I ) , I = 1 ,NEQB) 

IF  (M.EQ. NBLOCK)  GO  TO  200 

READ  (3)  ( (B  ( I , L) , I =K , NE2B) , L=1 , LL) , (TMASS  ( I ) , I =K , NE2B) 

200  CONTINUE 
C 

REWIND  7 
REWIND  2 
NA=7 

NUME-NUM7 

IF  (MM.NE.l)  GO  TO  75 
NA-2 

NUME-NUMEL 
NUM7  =0 
C 

75  DO  700  N-l.NUME 

READ  (NA)  LRD.ND,  (LM ( I ) , 1=1  ,ND)  , (SS  (I)  , 1-1  ,LRD) 

MSHFT  = ND  * (ND+D/2  +4  *ND 

DO  600  1=1, ND 

LMN-l-LM(l) 

I I =LM  ( I ) -NSH I FT 

IF  (I  I .LE.O.OR. I I .GT.NE2B)  GO  TO  600 
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I MS-I+MSHFT 

TMASS  (II) -TMASS ( I I ) + SS  ( I MS) 

DO  300  L= 1 , LL 
DO  300  J-l  ,4 

KK  = ND  *(ND+l)/2  + ND*(J-1) 

300  B ( I I . L)  =B  (I  I , L)  +SS  ( l+KK)  *STR  (J  , L) 

DO  500  J=1 , ND 
J J-LM (J)  +LMN 
IF(JJ)  500,500,390 
390  IF  (J- I ) 396.394,394 
394  KK  = ND*l-(l-l)*l/2  +J-ND 
GO  TO  400 

396  KK  =ND*J  -(J-l)*J/2+l-ND 
400  A ( I I ,JJ)-A(I  I ,JJ)+SS(  KK) 

500  CONTINUE 
600  CONTINUE 
C 

C DETERMINE  IF  STIFFNESS  IS  TO  BE  PLACED  ON  TAPE  7 
C 

IF  (MM.GT.l)  GO  TO  700 
DO  650  1-1, ND 
ll-LM(l)  -NSHIFT 

I F (I  I .GT.NE2B.AND. I I .LE.NEBB)  GO  TO  660 
650  CONTINUE 
GO  TO  700 

660  WRITE  (7)  LRD.ND,  (LM(I)  , l-l.ND)  , (SS(I)  , l-l.LRD) 

NUM7-NUM7+1 

C 

700  CONTINUE 

DO  710  L-l.NEQB 
ANORM=ANORM  + A (L, 1) 

IF  (A  (L , 1 ) .NE.O.)  NDEG-NDEG  + 1 
IF  (A  (L , 1 ) . EQ.O .)  A (L  , 1)  =1  . E+20 
IF  (TMASS  (L)  .NE.O.)  NVV-NVV  + 1 
710  CONTINUE 
C 

C FOR  STEP-BY-STEP  ANALYSIS  ADD  THE  MASS  CONTRIBUTIONS  TO 
C THE  EQUATION  DIAGONAL  COEFFICIENTS 
C 

I F (NDYN.NE.4)  GO  TO  716 
DO  714  l-l.NEQB 

714  A(l  ,1)  - A(l  ,1)  + AO*  TMASS  (I) 

WRITE  (4)  ( (A  (I , J) , l-l.NEQB) .J-l.MBAND) 

GO  TO  718 

716  WRITE  (4)  ((A(l  ,J)  , l-l.NEQB)  .J-l.MBAND)  , ((B(I,L)  ,1-1, NEQB)  .L-l.LL) 

cmo 

718  WRITE  (9)  (TMASS  ( I) , 1-1, NEQB) 


c moayyad 

c do  2 1 2 i -1 , neqb 

c2 1 2 write  (6,213)  (a(i,j)  ,j-l,mband) 

c213  format  (6el 2 .5) 

I F (M. EQ.NBLOCK)  GO  TO  1000 
DO  720  L-K.NE2B 
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ANORM=ANORM  + A (L , 1 ) 

I F (A  (L, 1)  .NE.O.)  NDEG=NDEG  + 1 
IF  (A  (L . 1 ) . EQ.O.)  A (L , 1)  =1  . E+20 
IF  (TMASS  (L)  .NE.O.)  NVV=NVV  + 1 
720  CONTINUE 
C 

I  F (NDYN.NE.lt)  GO  TO  726 
DO  724  I =K , NE2B 

724  A (1,1)  = A (1,1)  + AO*  TMASS (I ) 

WRITE  (4)  ( (A  (I  , J)  , I =K,NE2B)  , J=1  , MB AND) 

go  to  728 

726  wr i te  (4)  ( (a  (i , j) , i=k,ne2b) , j = l ,mband) , ( (b  (i , I) , i=k,ne2b) ,1  = 1,11) 
728  WRITE  (9)  (TMASS (I) , l=K,NE2B) 

C 

IF  (MM.EQ.MB)  MM=0 
MM=MM+ 1 

1000  NSH I FT=NSH I FT+NE2B 

IF  (NDEG.GT.O)  GO  TO  730 
WRITE  (6,1010) 

STOP 

730  ANORM=  (ANORM/NDEG) *1 . E-8 
C 

RETURN 

1002  FORMAT  (4F10.0) 

1004  FORMAT  (5 1 5. 3F 10.0) 

1010  FORMAT  (5 1 HOSTRUCTURE  WITH  NO  DEGREES  OF  FREEDOM  CHECK  DATA  ) 
2000  FORMAT  (///  10H  STRUCTURE , 1 3X , 7HELEMENT, 4X, 4HL0AD, 4X , 

1 1 1 HMULT I PL  I ERS , / 10H  LOAD  CASE , 1 2 X , 1 HA, 9X, 1HB, 9X, 1HC , 9X , 1HD , / IX) 
2002  FORMAT  ( I 6 , 7 X , 4 F 1 0 . 3) 

2004  FORMAT  (45H1S  TEP-BY-STEP  SOLUTION 

1 37HC  ONTROL  INFORMATION,/// 

2 5X,  35HNUMBER  OF  TIME  VARYING  FUNCTIONS  =,  15  // 

3 5X,  35HGR0UND  MOTION  INDICATOR  =,  15  / 

4 8X,  10HEQ.0,  NONE,  / 

5 8X,  29HGT.0,  READ  ACCELERATION  INPUT,  // 

6 5X,  35HNUMBER  OF  ARRIVAL  TIMES  =,  1 5 / 

7 8X,  26HEQ.0,  ALL  FUNCTIONS  ARRIVE,  / 

8 8X,  18H  AT  TIME  ZERO,  // 

9 5X,  35HNUMBER  OF  SOLUTION  TIME  STEPS  =,  15  // 

A 5X,  35HOUTPUT  (PRINT)  INTERVAL  =,  15  // 

B 5X,  35HSOLUT I ON  TIME  INCREMENT  =,  E14.4  // 

C 5X,  30HMASS-  PROPORTIONAL  DAMPING,  / 

D 5X,  35HCOEFF I C I ENT  (ALPHA)  =,  E14.4  // 

E 5X,  30HST I FFNESS- PROPORT  I ONAL  DAMPING,  / 

F 5X,  35HCOEFF I C I ENT  (BETA)  =,  E14.4  ///  IX) 

3000  FORMAT  (27HO***  ERROR  ZERO  TIME  STEP,  / IX) 

END 

c********************************  s7 . f re 

SUBROUTINE  ADDMAS  (TMASS, BLKMAS.NEQ.NEQB.NBLOCK) 

C 

C CALLED  BY?  STEP 
C 

C THIS  ROUTINE  READS  THE  SYSTEM  MASS  MATRIX  IN  BLOCKED  FORM 
C FROM  *TAPE9*  AND  ASSEMBLES  THE  BLOCKS  INTO  A SINGLE  VECTOR 

C *NEQ*  WORDS  IN  LENGTH  — I.E.,  SYSTEM  MASS  MATRIX  (DIAGONAL) 
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C IS  STORED  IN  CORE.  SYSTEM  MASS  MATRIX  *TMASS*  IS  SAVED  ON 

C *TAPE3*> 

C 

DIMENSION  TMASS(NEQ) , BLKMAS  (NEQB) 

C 

NT3  = 3 
REWIND  NT3 
NT9  - 9 
REWIND  NT9 
C 

KSHIFT  = 0 
C 

C LOOP  ON  THE  TOTAL  NUMBER  OF  SYSTEM  EQUATION  BLOCKS 
C 

DO  200  K=1 , NBLOCK 
READ  (NT9)  BLKMAS 
K 1 = KSHIFT 
DO  100  L=1 , NEQB 
K 1 = K 1+1 

IF  (K 1 .GT.NEQ)  GO  TO  250 
TMASS  (Kl)  = BLKMAS  (L) 

100  CONTINUE 

KSHIFT  = KSH I FT+NEQB 
200  CONTINUE 
C 

250  WRITE  (NT3)  TMASS 
C 

RETURN 

END 

SUBROUTINE  BANDET  (A , B , V, MAXA , NN , NWA.RA.NSCH , DET, I SCALE , KK) 
C 

C CALLED  BY?  SECNTD 

C 

COMMON  /TAPES/NSTI F ,NRED,NL,NR,NT ,NMASS 
DIMENSION  A (NWA)  ,B(1)  ,V(1)  , MAXA  ( 1 ) 

C 

NR-NN- 1 

IF  (KK-2)  100,700,800 

C 

100  T0L=1 .0E+07 

RTOL-1 - 0 E - 1 0 
C SCALE-2. ODO**200 

C***  SCALE-2. DO** 1 66 

SCALE-2. D0**10 
NTF-3 
I S-l 

120  REWIND  NSTIF 

READ  (NSTIF)  A 
DO  140  1-1, NN 
140  A ( I ) -A  ( I ) -RA*B  ( I ) 

160  IF  (NWA.EQ.NN)  GO  TO  230 
DO  200  N=1 , NR 
I H-N+NWA-NN 

IF  (A  (1 H) ) 220,215,220 
IH-IH-NN 


210 

215 
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GO  TO  210 

220  MAXA  (N)  = I H 
PI V=A  (N) 

IF(PIV)  221,500,221 

500  IS  - IS+1 

IF  (IS.LE.NTF)  GO  TO  502 

501  WRITE  (6,1000)  NTF.RA 
STOP 

502  RA  * RA*  (1 .O-RTOL) 

GO  TO  120 

221  I L=N+NN 
L=N 

DO  240  1=1 L, IH.NN 

L=L+1 

C-A(l) 

IF  (C)  225,240,225 

225  C=C/PIV 

IF  (ABS(C)  .LT.  TOL)  GO  TO  235 

226  IS=IS+1 

IF  (IS.LE.NTF)  GO  TO  245 
GO  TO  501 

245  RA=RA*  (1 .O-RTOL) 

GO  TO  120 
235  J-L-l 

DO  260  K=l , IH.NN 
260  A (K+J) =A  (K+J) -C*A  (K) 

A ( I ) =C 

240  CONTINUE 
200  CONTINUE 

230  IF  (A  (NN)  .NE .0.0)  GOTO  280 
AA=ABS  (A  (1) ) 

DO  290  1=2, NR 
290  AA=AA+ABS  (A ( I ) ) 

A (NN)  =-  (AA/NR)  *1  .OE- 1 6 
C 

280  NSCH=0 
ISC=0 
DET=1 .0 
DO  300  1=1 , NN 

IF  (ABS(DET)  .LT.  SCALE)  GOTO  320 
DET=DET/SCALE 
ISC-ISC+1 

320  DET=DET*A ( I ) 

300  IF  (A(I).LT.O.)  NSCH-NSCH+1 

C 

IF  (I SCALE.LT. 1000)  GO  TO  340 
I SCALE- 1 SC 
GO  TO  900 

340  IF  ( I SC- 1 SCALE)  350,900,370 

350  DET-DET/SCALE 
GO  TO  900 

370  DET=DET*SCALE 
GO  TO  900 
C 

700  I L=NN 
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DO  400  N= 1 , NR 
C=V  (N) 

V (N)  -C/A  (N) 

IF  (NWA-NN)  410,400,410 
410  I L= I L+l 

I H=MAXA (N) 

K=N 

DO  420  l-IL, IH.NN 
K*K+1 

420  V (K)  *V  (K)  -C*A  (I) 

400  CONTINUE 

V (NN)  =V  (NN)  / A (NN) 

C 

800  IF  (NWA-NN)  430,900,430 
430  N=NN 

DO  440  L=2 , NN 
N=N- 1 
I L=N+NN 
I H=MAXA  (N) 

K*N 

DO  460  I = I L , I H , NN 
K=K+1 

460  V (N)  =V  (N)  - A ( I ) *V  (K) 

440  CONTINUE 
900  RETURN 
C 

1000  FORMAT  (37HO***ERROR  SOLUTION  STOP  IN  *BANDET*,  / 12X, 

1 1 H (, 13, 37H)  TRIANGULAR  FACTORIZATIONS  ATTEMPTED,  / 12X, 

2 16HCURRENT  SHIFT  = , E20 . 1 4 / IX) 

C 

END 

SUBROUTINE  BENDDC  (NEL.NI ,NJ,X1 , X2 , X3,R, KODE , A.MODEX .THETA ,TOL , P I ) 
C 

C CALLED  BY?  PIPEK 

C 

C COMPUTATION  OF  DIRECTION  COSINE  ARRAY  FOR  THE  LOCAL  AXES  OF  A 
C CIRCULAR  BEND  PIPE  ELEMENT 


C 

C NEL 

C N I 

C NJ 

C XI 

C X2 

C X3 

C KODE 

C 
C 

C R 

C A 

C 
C 
C 

C MODEX 

C 

C 


ELEMENT  NUMBER 

NODE  NUMBER  AT  END  I 

NODE  NUMBER  AT  END  J 

GLOBAL  COORDINATES  OF  END  I 

GLOBAL  COORDINATES  OF' END  J 

GLOBAL  COORDINATES  OF  THE  THIRD  POINT 

CODE  DEFINING  THE  THIRD  POINT 

(EQ.l,  TANGENT  INTERSECTION  POINT) 

(EQ.2,  CENTER  OF  CURVATURE) 

RADIUS  OF  THE  BEND 

MATRIX  OF  DIRECTION  COSINES  RELATING  LOCAL  TO  THE 
GLOBAL  SYSTEM.  A ( I , J)  IS  THE  PROJECTION  ON  THE 
l-TH  GLOBAL  AXIS  OF  A UNIT  VECTOR  IN  THE  LOCAL 
J-DIRECTION. 

EXECUTION  MODE 
(EQ.O,  SOLUTION) 

(EQ.l,  DATA  CHECK) 
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C THETA  * CENTRAL  ANGLE  SUBTENDED  BY  THE  ARC  OF  THE  BEND 

C TOL  = DIMENSIONAL  TOLERANCE  USED  FOR  ERROR  TESTING 

C PI  = 3.11*159... 

C 

DIMENSION  XI  (3)  ,X2(3)  ,X3(3)  , A (3.3)  • B (3) 

common  /say/  neqq.numee, 1 oopur , nnb 1 ock , nterms , option 

common  /what/  naxa  (lOOOO) , i rowl  (10000) , icolh  (10000) 

C 

GO  TO  (10, 1 10) , KODE 
C 

C TANGENT  INTERSECTION  IS  THE  THIRD  POINT 
C 

C 1 . LOCAL  X-AXIS  VECTOR 

C 

10  A (1  . 1 ) = X3  (1)  -XI  (1) 

A (2,1)  * X3  (2)  -XI  (2) 

A (3,0  - X3  (3)  -XI  (3) 

XL  1 T = A(l,l)**2  + A(2,1)**2  + A(3,l)**2 
XL  1 T =SQRT(XL1T) 

I F (XL1T.GT. 1 .OE-8)  GO  TO  20 
NN  - Nl 

15  WRITE  (6,3000)  NEL.NN 
MODEX  = 1 
RETURN 

20  DUM  = 1 .0/  XL  IT 
DO  25  K=1 ,3 

25  A (K,  1)  * A (K , 1)  * DUM 
C 

C 2.  VECTOR  FROM  TANGENT  POINT  TO  NODE  J 

C 

DO  30  K-1,3 
30  B(K)  = X2(K)-X3(K) 

XLT2  = B(l)**2  + B (2)  **2  + B (3)  **2 
XLT2  =SQRT  (XLT2) 

I F (XLT2.GT.  1 -OE-8)  GO  TO  1*0 
NN  = NJ 
GO  TO  15 
C 

C 3.  COMPARE  DISTANCES  BETWEEN  THE  NOOES  AND  THE  COMMON  TANGENT 

C INTERSECTION  POINT 

C 

1*0  DIF  -ABS  (XL  1T-XLT2) 

IF  (DIF. LE. TOL)  GO  TO  1*2 
WRITE  (6,3010)  NEL ,TOL , XL  IT, XLT2 
MODEX  - 1 
RETURN 
C 

42  CONTINUE 
C 

C 1*.  LOCAL  Z-AXIS 

C 

A (1 , 3)  = A (2 , 1 ) *B  (3)  - A (3,  1)  *B  (2) 

A (2.3)  = A (3, 1)  *B  (1)  - A (1 , 1)  *B  (3) 

A (3, 3)  = A (1 , 1)  *B  (2)  - A (2 , 1)  *B  (1) 

DUM  = 0.0 
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DO  44  K-1,3 

44  DUM  = DUM  + A(K,3)**2 
DUM  -SQRT (DUM) 

I F (DUM.GT. 1 .OE-8)  GO  TO  46 
WRITE  (6,3060)  NEL 
MODEX  = 1 
RETURN 

46  DUM  = 1 .O/DUM 
DO  48  K-l ,3 

48  A (K,  3)  = A (K,  3)  * DUM 
C 

C 5.  LOCAL  Y-AXIS 

C 

A (1  ,2)  = A (2,3)  *A  (3,  1)  - A (3.3)  *A  (2,1) 

A (2 , 2)  = A (3, 3)  *A  (1  , 1)  - A(1,3)*A(3.1) 

A (3,2)  = A (1  , 3)  *A  (2,  1)  - A (2,3)  * A (1,1) 

C 

C 6.  COMPUTE  THE  CENTRAL  ANGLE 

C 

DUM  = XL1T/R 

THETA  = 2.0DO*ATAN (DUM) 

50  CONTINUE 

I F (THETA .GT. I .OE-8  .AND.  THETA. LE. PI)  RETURN 
DUM  = THETA*l80.0/PI 
WRITE  (6,3020)  DUM, NEL 
MODEX  = 1 
RETURN 
C 

C CENTER  OF  CURVATURE  IS  THE  THIRD  POINT 
C 

C 1 . LOCAL  Y-AXIS  VECTOR 

C 

no  A (1  , 2)  = X3(1)-X1  (1) 

A (2 , 2)  = X3  (2)  -xi  (2) 

A (3.2)  = X3  (3)  -XI  (3) 

D1C  = 0.0 
DO  120  K-1,3 

120  D1C  = D1C  + A (K, 2) **2 
D1C  -SQRT  (D 1 C) 

IF  (D1C. GT. 1 .OE-8)  GO  TO  130 
NN  = N I 

125  WRITE  (6,3030)  NEL , NN 
MODEX  - 1 
RETURN 

130  DUM  - 1 .0/  D1C 
DO  135  K-1,3 

135  A (K,  2)  - A (K , 2)  * DUM 
C 

C 2.  COMPUTE  THE  VECTOR  FROM  NODE  J TO  THE  C.C. 

C 

B (1)  = X3  (1)  -X2  (1) 

B (2)  - X3(2)-X2(2) 

B (3)  * X3  (3)  -X2  (3) 

D2C  - 0.0 
DO  140  K=1 ,3 
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HO  D2C  = D2C  + B(K)**2 
D2C  -SQRT (D2C) 

IF  (D2C.GT. 1 .OE-8)  GO  TO  150 
NN  = NJ 
GO  TO  125 
150  CONTINUE 
C 

C 3.  COMPARE  COMPUTED  RADII  VERSUS  THE  INPUT  VALUE 

C 

DIF  -ABS(R-DIC) 

IF  (DIF.LT.TOL)  GO  TO  165 
NN  = Nl 
RR  = D1C 

160  WRITE  (6,301*0)  NN,NEL,R,RR 
MODEX  = 1 
RETURN 

165  DIF  =ABS  (R-D2C) 

I F (DIF.LT.TOL)  GO  TO  170 
NN  = NJ 
RR  = D2C 
GO  TO  160 
C 

C k.  LOCAL  Z-AXIS  VECTOR 

C 

170  A(l, 3)  = A (2 , 2)  *B  (3)  - A (3. 2)  *B  (2) 

A (2 , 3)  = A (3. 2)  *B  0)  “ A(1,2)*B(3) 

A (3. 3)  = A ( 1 , 2)  *B  (2)  - A(2,2)*B(1) 

DUM  * 0.0 
DO  172  K-1,3 

172  DUM  = DUM  + A (K.3) **2 
DUM  =SQRT  (DUM) 

IF  (DUM.LT.l .OE-8)  GO  TO  177 
DUM  = 1 .O/DUM 
DO  173  K-1,3 

173  A (K,  3)  = A (K , 3)  * DUM 
C 

C 5.  TEST  FOR  NODES  I AND  J COINCIDENT 

C 

CHORD  = 0.0 
00  175  K-1,3 

175  CHORD  - CHORD  + (X2  (K) -X 1 (K) ) **2 
CHORD  -SQRT  (CHORD) 

IF  (CHORD. GT. 1 .OE-8)  GOTO  180 
177  WRITE  (6,3050)  N I , NJ , NEL 
MODEX  - 1 
RETURN 
C 

C 6.  LOCAL  X-AXIS  VECTOR 

C 

180  A ( 1 , 1)  = A (2 , 2)  *A  (3 , 3)  " A (3,2)  *A  (2,3) 

A (2,  1)  = A (3,2)  *A  (1,3)  " A (1 , 2)  *A  (3, 3) 

A (3.  1)  - A (1 , 2)  *A  (2 , 3)  - A (2 , 2)  *A  (1 , 3) 

C 

C 7.  COMPUTE  THE  CENTRAL  ANGLE 

C 
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DUM  = 0.5*CH0RD/R 

C***  THETA  = 2.0D0*DARSIN  (DUM) 

THETA  = 2.0D0*ASIN (DUM) 

GO  TO  50 
C 

3000  FORMAT  (25HOERROR***  BEND  ELEMENT  (,  I4,19H)  HAS  ZERO  DISTANCE, 

1  15H  BETWEEN  NODE  (,H*,31H)  AND  THE  TANGENT  INTERSECTION.,  / IX) 
3010  FORMAT  (45H0ERR0R***  TANGENT  LENGTHS  FOR  BEND  ELEMENT  (.I1*, 

1 27H)  ARE  NOT  EQUAL  TO  WITHIN  (.E11.1+,  2H)  . , / 

2 1 1X.23HI -NODE  TANGENT  LENGTH  -,E20.8,  / 

3 1 1 X , 23HJ-NODE  TANGENT  LENGTH  «,E20.8,  / IX) 

3020  FORMAT  (30HOERROR***  THE  CENTRAL  ANGLE  (,F8.3»10H)  FOR  BEND, 

1 10H  ELEMENT  (,l4,l8H)  IS  OUT  OF  RANGE.,  / 11X, 

2 38HTHETA  MUST  BE  GT.O  AND  LT.180  DEGREES.,  / IX) 

3030  FORMAT  (25HOERROR***  BEND  ELEMENT  (,M*f19H)  HAS  ZERO  DISTANCE, 

1 15H  BETWEEN  NODE  (,IA,30H)  AND  THE  CENTER  OF  CURVATURE.,/  IX) 
3040  FORMAT  (36HOERROR***  COMPUTED  RADIUS  TO  NODE  (,I4,10H)  FOR  BEND, 

1 10H  ELEMENT  (,U,38H)  IS  DISCREPANT  FROM  THE  INPUT  RADUIS.,  / 

2 1 IX.  1 7HRAD I US  INPUT  -.E20.8  / 

3 1 1 X , 1 7HRAD I US  COMPUTED  «,E20.8  /IX) 

3050  FORMAT  (44HOERROR***  ZERO  CHORD  LENGTH  BETWEEN  NODES  (,I4, 

1 7H)  AND  (,IU,19H)  IN  BEND  ELEMENT  (,I4,2H).,  / IX) 

3060  FORMAT  (51H0ERR0R***  TANGENT  INTERSECTION  POINT  FOR  ELEMENT  (, 

1 14,1 8H)  IS  ON  THE  CHORD.,  / IX) 


C 


END 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


CALLS?  PINVER 
CALLED  BY?  PIPEK 

COMPUTATION  OF  THE  ELEMENT  STIFFNESS  AND  LOAD  MATRICES  FOR  A 
CIRCULARLY  CURVED  PIPE  BEND  ELEMENT. 


ALFAV 

NOAX 

E 

* XNU 
XKP 
AREA 
XMI 
T 
ST 
CT 

NODE 

NEL 

MODEX 

F (6,6) 
R 

THERM 

P 

WALL 


SHAPE  FACTOR  FOR  SHEAR  DISTORTION 
(GT.99.99,  NEGLECT) 

CODE  FOR  NEGLECTING  AXIAL  DEFORMATIONS 
(EQ.l,  NEGLECT) 

YOUNG*S  MODULUS 
POISSON*S  RATIO 

PRESSURE  DEPENDENT  FLEXIBILITY  FACTOR 

SECTION  AREA 

MOMENT  OF  INERTIA 

ANGLE  OF  THE  BEND,  THETA 

SIN  (THETA) 

COS  (THETA) 

NODE  NUMBER  AT  END  J OF  THE  BEND 
PIPE  ELEMENT  NUMBER 
EXECUTION  MODE 
(EQ.l,  DATA  CHECK) 

FLEXIBILITY  MATRIX  AT  NODE  J 
RADIUS  OF  THE  BEND 
THERMAL  EXPANSION  COEFFICIENT 
INTERNAL  PIPE  PRESSURE 
PIPE  WALL  THICKNESS 
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C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 


c 

c 

c 


c 

c 

c 


« OUTSIDE  DIAMETER  OF  THE  PIPE 
= FREE  END  DEFLECTIONS  AT  NODE  J DUE  TO 

(1)  UNIFORM  LOAD  IN  THE  X(l)  DIRECTION 

(2)  UNIFORM  LOAD  IN  THE  Y ( I ) DIRECTION 

(3)  UNIFORM  LOAD  IN  THE  Z (I ) DIRECTION 

(4)  UNIFORM  THERMAL  EXPANSION  (DT=1) 

(5)  P,  INTERNAL  PRESSURE 
= FORCE  TRANSFORMATION  RELATING  REACTIONS  AT  NODE  I 

DUE  TO  UNIT  LOADS  AT  NODE  J 
■ LOCAL  BEND  ELEMENT  STIFFNESS  MATRIX 
= FIXED  END  FORCES  (ACTING  ON  THE  NODES)  DUE  TO 

(1)  UNIFORM  LOAD  IN  THE  X(l)  DIRECTION 

(2)  UNIFORM  LOAD  IN  THE  Y (I ) DIRECTION 

(3)  UNIFORM  LOAD  IN  THE  Z(l)  DIRECTION 

(4)  UNIFORM  THERMAL  EXPANSION  (DT-1) 

(5)  P,  INTERNAL  PRESSURE 

- LUMPED  MASS  MATRIX 

= STRESS-DISPLACEMENT  TRANSFORMATION  RELATING  THE 
12  GLOBAL  COMPONENTS  OF  DISPLACEMENT  TO  THE  6 
LOCAL  COMPONENTS  OF  MEMBER  LOADS  LOCATED  AT  NODE 
I,  MIDPOINT  OF  THE  ARC  AND  AT  NODE  J. 

= FIXED-END  FORCE  CORRECTIONS  TO  THE  MEMBER  LOADS 
DUE  TO  THE  FIVE  (5)  TYPES  OF  ELEMENT  LOADS 

- MASS  PER  UNIT  LENGTH  OF  THE  SECTION 

= ARRAY  OF  DIRECTION  COSINES  WHICH  TRANSFORMS  LOCAL 

VECTORS  TO  GLOBAL  VECTORS 
SUBROUTINE  BENDKS 

COMMON  /PIPEC/ALFAV,E,XNU, XKP, T, NOAX, NODE ,NEL, 

1 MODEX.R, THERM, P, AREA, XMI .WALL , DOUT, XMAS 

COMMON  /EM/  I XX  (14) , S ( 1 2, 1 2) ,RF (12,4)  , XM (1 2) , SA (1 8, 1 2)  , 

1 SF  (18,4)  , FEF  (12,5)  , FEFC  (1 8. 5)  ,F  (6,6)  ,B  (6,6)  , 

2 H (6,6)  ,DC(3,3)  , IFILL2(3606) 

COMMON  /ELPAR/  NPAR  (14) , I F I LL 1 (10) 

common  /say/  neqq, numee, 1 oopur , nnb lock , nterms.opt i on 
common  /what/  naxa  (10000) , i rowl  (10000) , icolh  (10000) 

DIMENSION  COL  (6) 

SET  THE  FACTOR  FOR  AXIAL  DEFORMATIONS 

AXIAL  - 1.0 

I F (NOAX. EQ. 1)  AXIAL  - 0.0 

SET  THE  FACTOR  FOR  SHEAR  DEFORMATIONS  (EQ.O,  NEGLECT) 

XKAP  - ALFAV 

I F (ALFAV.GT.99.99)  XKAP  - 0.0 

SET  THE  FLEXIBILITY  FACTORS 

XKO  = XKP 
XK1  - XKP 


DOUT 

B 


H 

S 

FEF 


XM 

SA 


FEFC 

XMAS 

DC 


C 

c 

c 


COMPUTE  THE  MATERIAL  FACTORS 
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RE  = l.O/E 
XNU1  = l.O+XNU 
C 

C COMPUTE  SECTION  PROPERTY  CONSTANTS 

C 

RA  = AX  I AL*R*RE/AREA 
RV  = XKAP*XNU1 *R*RE/ AREA 
RT  = 0.5*XNU1*R*RE/XMI 
RBO  = 0.5*XK0*R*RE/XMI 
RBI  = XK1*R*RE/XMI 
R2  = R**2 
C 

C COMPUTE  COMMON  TRIGONOMETRIC  CONSTANTS 

C 

ST  -SIN(T) 

CT  =COS  (T) 

S2T  -SIN  (2.0*T) 

C2T  =COS  (2.0*T) 

T2  = T**2 
C 

C FORM  THE  NODE  FLEXIBILITY  MATRIX  AT  NODE  J REFERENCED  TO  THE 

C LOCAL  (X , Y , Z)  COORDINATE  SYSTEM  AT  NODE  I. 

C 

C X - DIRECTION...  IN-PLANE  TANGENT  TO  THE  BEND  AT  NODE  I AND 
C DIRECTED  TOWARD  NODE  J 

C Y - DIRECTION...  IN-PLANE  AND  DIRECTED  RADIALLY  INWARD  TO  THE 
C CENTER  OF  CURVATURE 

C Z - DIRECTION...  OUT  OF  PLANE  AND  ORTHOGONAL  TO  X AND  Y 
C 

DO  50  1-1,6 
DO  50  K= I ,6 
F (I  ,K)  =0.0 
50  CONTINUE 
C 

C AXIAL 
C 

F (1  , 1)  = F (1,1)  + 0.25*RA*(2.0*T+S2T) 

F (2,2)  = F (2 , 2)  + 0.25*RA*(2.0*T-S2T) 

C NOTE  (COEFFICIENT  CHANGE) 

F (1,2)  = F (1,2)  + 0.50*RA*  ST**2 
C 

C SHEAR 

C 

F (1,1)  = F (1  , 1)  + 0.5*RV*(2.0*T-S2T) 

F (2,2)  * F (2 , 2)  + 0.5*RV*(2.0*T+S2T) 

F (3,3)  - F (3,3)  + 2 .0*RV*  T 
C NOTE  (SIGN  CHANGE) 

F (1,2)  = F (1,2)  - RV*  ST**2 

C 

C TORSION 

C 

F (3,3)  - F (3,3)  + 0.5*RT*R2*(6.0*T+S2T-8.0*ST) 

F (1+ , 1+)  = F (!♦,!♦)  + 0.5*RT*  (2.0*T+S2T) 

F (5.5)  - F (5,5)  + 0.5*RT*  (2.0*T-S2T) 

F(3,l»)  = F (3,4)  + RT*R  * (ST-T*CT) 
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F (3,5)  = F (3,5)  + RT*R  * (2 .0-2 .0*CT-T*ST) 

F (4,5)  = F (4,5)  + 0.5*RT*  (1.0-C2T) 

C 

C BENDING 
C 

F (1,1)  -F(l,l)  + 0.25*RB1*R2*(2.0*T*(2.0+C2T)-3.0*S2T) 

F (2,2)  * F (2,2)  + 0.25*RB1*R2*(2.0*T*(2.0-C2T)+3.0*S2T-8.0*ST) 

F (3,3)  = F (3,3)  + 0.50*RB0*R2*  (2.0*T-S2T) 

F(L,4)  = F (1* , 1*)  + 0.50*RB0*  (2 . 0*T-S2T) 

F (5,5)  - F (5.5)  + 0.50*RB0*  (2 .0*T+S2T) 

F (6,6)  = F (6,6)  + RB1*T 

F (1.2)  = F (1,2)  + 0.25*RB1*R2*  (1  .0+3.0*C2T+2.0*T*S2T-l*.0*CT) 

F (1,6)  = F ( 1 , 6)  - RB1*R  * (ST-T*CT) 

F (2,6)  = F (2,6)  + RB1*R  * (T*ST+CT- 1 .0) 

F(3,4)  = F (3,4)  + RB0*R  *(ST-T*CT) 

F (3,5)  * F (3,5)  " RB0*R  *T*ST 

F(l*,5)  = F (4,5)  - 0.50*RB0*  (1.0-C2T) 

C 

DO  60  1=1,6 
DO  60  K=l ,6 
F (K,  I)  = F (I  , K) 

60  CONTINUE 

C****  PRINT  THE  NODE  FLEXIBILITY  MATRIX 
I F (NPAR  (10)  .LT. 1)  GO  TO  6700 
WRITE  (6,4000) 

WRITE  (6,1*010)  ((F  (I  ,K)  ,K=1,6)  , 1 = 1,6) 

6700  CONTINUE 

C 

C FORM  THE  NODE  STIFFNESS  MATRIX 
C 

CALL  PINVER  (F , 6 , 6, NODE , NEL .MODEX) 

C**A*  PRINT  THE  NODE  STIFFNESS  MATRIX 
IF  (NPAR  (10)  . LT . 1 ) GO  TO  670 1 
WRITE  (6,1*020) 

WRITE  (6,1*030)  ( (F  (I  , K)  ,K=1,6)  ,1  = 1,6) 

6701  CONTINUE 

c 

C COMPUTE  THE  OEF LECT I ONS/ROTAT I ONS  (MEASURED  IN  THE  X,Y,Z  SYSTEM 

C AT  NODE  I)  AT  NODE  J DUE  TO  UNIFORM  LOADS  IN  EACH  OF  THE  X.Y.Z 

C DIRECTIONS  (AT  I).  THE  UNIFORM  LOADS  ARE  DIRECTION  INVARIANT 

C WITH  POSITION  ALONG  THE  ARC,  AND  NODE  I IS  FIXED  WHILE  NODE  J IS 

C COMPLETELY  FREE. 

C 

DO  70  1=1,6 
DO  70  K-1,3 
B ( I , K)  = 0.0 
70  CONTINUE 
C 

C AXIAL 

C 

RA  = 0 . 1 25*RA*R 

B ( 1 , 1 ) = B ( 1 , 1)  + RA*(2.0*T2-C2T+1 .0) 

B (2 , 2)  = B (2 , 2)  + RA*(2.0*T2+C2T-1 .0) 
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C 

c 

c 

c 

c 


c 

c 

c 

c 

c 


c 

c 

c 


c 

c 

c 

c 


c 


c 

c 

c 


note  (COEFFICIENT  change) 

B (1 , 2)  = B (1  . 2)  + RA*(2.0*T-S2T) 

NOTE  (COEFFICIENT  CHANGE) 

B (2, 1)  = B (2 , 1)  + RA*(2.0*T-S2T) 

SHEAR 

RV  = 0.25*RV*R 

B (1 , 1 ) = B (1 , 1)  + RV*(2.0*T2+C2T-1  .0) 

B (2, 2)  = B (2 , 2)  + RV*(2.0*T2-C2T+1  .0) 

B(3,3)  - B (3. 3)  + 4.0*RV*T2 
NOTE  (SIGN  CHANGE) 

B (1 , 2)  = B (1 , 2)  - RV*(2.0*T-S2T) 

NOTE  (SIGN  CHANGE) 

B (2 , 1 ) = B (2, 1)  - RV* (2 .0*T-S2T) 

TORSION 


RT  = RT*R2 
B (3.3)  - B (3. 3) 
B (4, 3)  - B (4, 3) 
B(5.3)  - B (5. 3) 


+ 0 . 5*RT*R*  (1 .0+2.0*T2-4.0*T*ST-C2T) 
+ RT*  (2.0-2 .0*CT-T*ST) 

+ RT*  (T*(2.0+CT)-3«0*ST) 


BENDING 


RBO  = RB0*R2 


RBI  = RB 1 *R2 
B (1 , 1)  = B (1 , 1) 

B (2 , 2)  = B (2 , 2) 

B (3. 3)  = B (3. 3) 
B (1  , 2)  = B (1 , 2) 
B (2,  1)  = B (2,1) 
B (4, 3)  - B (4, 3) 
B (5, 3)  = B (5,3) 
B (6, 1 ) = B (6, 1 ) 
B (6 , 2)  = B (6 , 2) 


+ 

+ 

+ 

+ 

+ 

+ 


+ 


0. 125*RB1*R*  (7 .0+2 .0*T2+9«0*C2T+4 .0*T*S2T 
-l6.0*CT) 

0 . 1 25*RB1 *R*  (1 .0+2.0*T2-9-0*C2T-4.0*T*S2T 
+8.0*  (CT-T*ST) ) 

0 . 500*RB0*R* (3.0+C2T-4 .0*CT) 

0. 125*RB1*R*(9.0*S2T-4.0*T*(C2T+2.0*CT)  -6.0*T) 
0. 125*RB1*R*  (9 .0*S2T-4 .0*T*C2T-24 .0*ST+10 .0*T) 
RBO*  (2 .0-2 .0*CT-T*ST) 

RBO*  (ST-T*CT) 

RBI*  (2 .0-2 .0*CT-T*ST) 

RBI*  (2.0*ST-T-T*CT) 


COMPUTE  THE  FREE  NODE  DEFLECTIONS  AT  END  J DUE  TO  A UNIFORM 


THERMAL  EXPANSION 


DO  80  1-1,6 
B ( I ,4)  - 0.0 
80  CONTINUE 


DUM  - R*THERM 
B (1 ,4)  - DUM*ST 
B (2 , 4)  - DUM*  (1  .O-CT) 

COMPUTE  THE  FREE  NODE  DEFLECTIONS  AT  END  J DUE  TO  PRESSURE 


DO  90  1=1,6 
B (I  ,5)  * 0.0 
90  CONTINUE 
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C 

C COMPUTE  THE  ANGLE  CHANGE  AND  END  DISPLACEMENTS  AT  THE  FREE  END 
C OF  THE  BEND  DUE  TO  INTERNAL  PRESSURE,  P. 

C 

RM  = (DOUT-WALL) *0.5 
KK  = 1 

GO  TO  (92 . 94)  , KK 
C 

C MEL  REPORT  10-66,  EQUATION  (3-29). 

C 

92  CONTINUE 

DUM  = 3.  14159265*RM**4*P*T 
DUM  = 0.5*DUM*RE/XMI 
DU2  = RM/R 

BTA  - DUM*  (2.0-2. 0*XNU  + (3.0+1 .5*XNU) *DU2**2) 

GO  TO  96 
C 

C C.  S.  PARKER,  EQUATION  (10),  2-28-69. 

C 

9**  CONTINUE 
DU2  = R/RM 

DUM  = P*RM*0 . 5*RE/WALL 

DU3  = 1.0  + DUM* ( 1 ,0-XNU*(2.0*DU2-l .0) / (DU2-1 .0) ) 

BTA  - DU3/0.0  + DUM*  (2.0-XNU) ) 

BTA  = T*(l  .O-BTA) 

C 

96  CONTINUE 

DUM  = R/T*BTA 
B (1 ,5)  = DUM*  (ST-T*CT) 

B (2 , 5)  * DUM*  (1 ,0-CT-T*ST) 

B (6,5)  —BTA 
C 

C AXIAL  GROWTH  DUE  TO  PRESSURE.  MEL  REPORT  10-66,  EQUATION  (3-28). 

DUM  = 0.5*  P*  RM*  RE*  (1 .0-2 .0*XNU) * R/  WALL 
B (1 ,5)  * B ( 1 , 5)  + DUM*  ST 

B (2 , 5)  = B (2 , 5)  + DUM*  (1.0-CT) 

C****  PRINT  THE  FREE  END  DEFLECTIONS 
I F (NPAR  (10)  .LT. 1)  GO  TO  6702 
WRITE  (6,4050) 

WRITE  (6,4060)  ((B(I,K)  ,K-1,5)  ,1-1,6) 

6702  CONTINUE 
C**** 

C 

C SET  UP  THE  FORCE  TRANSFORMATION  RELATING  REACTIONS  AT  NODE  I 

C ACTING  ON  THE  MEMBER  END  DUE  TO  UNIT  LOADS  APPLIED  TO  THE  MEMBER 

C END  AT  NODE  J. 

C 

DO  100  1=1,6 

DO  100  K*1 ,6 

H (I  ,K)  =0.0 

100  CONTINUE 
C 

DO  105  K-1,6 
H (K , K)  —1.0 
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105  CONTINUE 
C 

H (4, 3)  — RMl.O-CT) 

H (5, 3)  = R*  ST 
H (6,  l)  — H (i*,3) 

H (6,2)  *-H  (5.3) 
c 

c FORM  THE  UPPER  TRIANGULAR  PORTION  OF  THE  LOCAL  ELEMENT  STIFFNESS 
C MATRIX  FOR  THE  BEND 
C 

do  no  k=i,6 
do  no  l=K,6 
S (K+6 , 1+6)  = F (K, I) 

110  CONTINUE 
C 

DO  130  I R=1 , 6 
DO  130  I C=1 ,6 
S (IR, I C+6)  - 0.0 
DO  120  IN=1 ,6 

S ( I R , I C+6)  = S ( I R,  I C+6)  + H ( I R , IN)*  F ( I N . I C) 

120  CONTINUE 
130  CONTINUE 
C 

DO  150  IR-1,6 
DO  150  IC-IR.6 
S ( I R,  1C)  = 0.0 
DO  140  IN=1 ,6 

S ( I R , I C)  = S ( I R , I C)  + S ( I R,  I N+6)  * H ( I C,  I N) 

140  CONTINUE 
150  CONTINUE 
C 

C REFLECT  FOR  SYMMETRY 
C 

DO  160  1=1,12 
DO  160  K= I , 1 2 
S (K , I ) = S (I  ,K) 

160  CONTINUE 

C****  PRINT  THE  BEND  LOCAL  STIFFNESS  MATRIX 
IF  (NPAR(IO)  .LT.  1)  GO  TO  6703 
WRITE  (6,4500) 

WRITE  (6,4510)  ((S(l ,J) ,J=1,6  ), 1=1,12) 

WRITE  (6,4510)  ( (S  (I , J)  ,J=7. 12)  ,1  = 1,12) 

6703  CONTINUE 
c **** 

C COMPUTE  THE  RESTRAINED  NODE  FORCES  ACTING  ON  THE  NODES  OF  THE 

C BEND  DUE  TO  THE  MEMBER  LOADINGS 

C 

DO  180  1=1,5 
DO  180  J=1 , 12 
FEF  (J,  I)  = 0.0 
DO  170  K-1,6 

FEF  (J , I ) = FEF(J.I)  - S (J , K+6)  * B(K,l) 

170  CONTINUE 
180  CONTINUE 
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C 

C FOR  THE  DISTRIBUTED  LOADS  SUPERIMPOSE  THE  CANTILEVER  REACTIONS 
C ACTING  ON  THE  ELEMENT  AT  NODE  I. 

C 

FEF  (1,1)  - FEF  (1,1)  - RAT 
FEF  (6,  1)  = FEF  (6,  1)  + R2*(T-ST) 

C 

FEF  (2,2)  * FEF  (2,2)  - R*T 

FEF  (6,2)  * FEF  (6,2)  - R2*(l  .O-CT) 

C 

FEF  (3,3)  * FEF  (3,3)  - R*T 

FEF  (4,3)  - FEF  (4,3)  - R2*(T-ST) 

FEF  (5,3)  = FEF  (5,3)  + R2*(l  .O-CT) 

C****  PRINT  THE  FIXED  END  QUANTITIES 

I F (NPAR  (10)  .LT. 1)  GO  TO  6704 
WRITE  (6,4600) 

WRITE  (6,4610)  ( (FEF  (I , J) , J*1 ,5) , 1 = 1.12) 

6704  CONTINUE 
C***ft 
C 

C FORM  THE  LUMPED  MASS  MATRIX 
C 

DUM  = 0.5*R*T*XMAS 
DO  200  K= 1,3 
XM(K)  = DUM 
XM  (K+6)  = DUM 
XM  (K+3)  = 0.0 
XM  (K+9)  =0.0 
200  CONTINUE 
C 

C COMPUTE  THE  FIXED-NODE  CORRECTIONS  TO  THE  MEMBER  LOADS  RESULTING 

C FROM  ELEMENT  LOADINGS.  FORCES  ACT  ON  THE  SEGMENT  BETWEEN  THE 

C POINT  WHERE  EVALUATED  AND  NODE  I. 

C 

C 1 . AT  NODE  I (ACTING  ON  NODE  I) 

C 

00  210  1=1 ,5 
DO  210  K= 1 , 6 
FEFC  (K, I)  = -FEF  (K, I) 

210  CONTINUE 
C 

C 2.  AT  NODE  J (ROTATE  I N-PLANE  FROCES  AN  AMOUNT  THETA) 

C 

DO  220  1=1,5 
DO  215  K=1 ,4,3 

FEFC (K+l  2 , I ) = CT*  FEF  (K+6, I)  + ST*  FEF(K+7,I) 

FEFC  (K-M 3. I ) = -ST*  FEF  (K+6, I)  + CT*  FEF  (K+7, I ) 

FEFC  (K+l 4, I)  = FEF  (K+8, I ) 

215  CONTINUE 
220  CONTINUE 
C 

C 3.  AT  THE  MIDPOINT  OF  THE  ARC  BETWEEN  NODES  I AND  J. 

C 

C A.  TRANSFER  FORCES  AT  NODE  J TO  THE  MIDPOINT  AND  ROTATE 

C AN  AMOUNT  THETA/2 
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C 

S12T  =SIN(0.5*T) 

C12T  =C0S(0.5*T) 

DX  = R*  (ST-S 1 2T) 

DY  = R*  (C 1 2T-CT) 

C 

DO  230  1-1,5 

XMIO  - FEF  (10,1)  + FEF  (9,0*  DY 

XM1 1 = FEF  (1  1 , I)  - FEF  (9.  0*  DX 

FEFC ( 7,1)  = C12T*  FEF  (7,1)  + S12T*  FEF  (8,1) 

FEFC ( 8,1)  = -S12T*  FEF  (7,1)  + C12T*  FEF  (8,1) 

FEFC ( 9,1)  = FEF  (9, I) 

FEFC  (10, I ) = C12T*  XMIO  +S12T*XM11 

FEFC  (11,1)  = -S12T*  XMIO  + C12T*  XM11 

230  FEFC  (12,  I ) = FEF  (12,  I ) - FEF  (7.1)*  DY  + FEF (8,1)*  DX 
C 

C B.  FOR  THE  DISTRIBUTED  LOADS  SUPERIMPOSE  THE  RESULTANT 

C OF  THE  APPLIED  LOADING  TRANSFERRED  TO  THE  MIDPOINT  OF 

C THE  ARC  AND  ROTATE  AN  AMOUNT  THETA/2  (IN-PLANE) 

C 

DDX  = R*  (2 .0*  (C 1 2T-CT) /T  - S12T) 

DDY  = R*  (2 .0*  (S 1 2T-ST) /T  + C12T) 

DUM  = R*T*0 . 5 
C 

FEFC  { 7,1)  = FEFC  ( 7,1)  + C12T*  DUM 

FEFC  ( 8,1)  = FEFC  ( 8,1)  - S12T*  DUM 

FEFC  (12,1)  = FEFC  (12,1)  - DDY  * DUM 

C 

FEFC  ( 7,2)  = FEFC  ( 7,2)  + S12T*  DUM 

FEFC  ( 8,2)  = FEFC  ( 8,2)  + C12T*  DUM 

FEFC  (12,2)  = F EFC  ( 1 2 , 2)  + DDX  * DUM 

C 

FEFC  ( 9,3)  - FEFC  ( 9,3)  + DUM 
XMIO  = DDY*  DUM 
XM1 1 = -DDX*  DUM 

FEFC  (10,3)  * FEFC  (10,3)  + C12T*  XMIO  + S12T*  XM1 1 

FEFC  (1 1 , 3)  = FEFC  (1 1 , 3)  - S12T*  XMIO  + C12T*  XM1 1 

C****  PRINT  THE  FIXED-END  CORRECTIONS 
IF  (NPAR  (10)  - LT.  1)  GO  TO  6705 
WRITE  (6,L650) 

WRITE  (6,1*660)  ( (FEFC  (I  • J)  . J-l  ,5)  , I - 1 . 1 8) 

6705  CONTINUE 
C**** 

C 

C FORM  THE  TRANSFORMATION  RELATING  GLOBAL  DISPLACEMENTS  AND  MEMBER 
C FORCES  AT  NODE  I,  MIDPOINT  AND  NODE  J. 

C 

C 1.  STRESS  RESULTANTS  AT  NODE  I 

C 

DO  260  Kl-1,10,3 
NRS  - K 1 - 1 
DO  260  K2=l , 10,3 
NCS  - K2-1 
DO  250  IR=1,3 
NR  = NRS+IR 
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00  250  IC=1 ,3 

NC  = NCS+IC 
SA  (NR, NC)  = 0.0 
DO  240  IN-1,3 
N * NCS+IN 

SA(NR.NC)  = SA  (NR , NC)  - S(NR,N)*  DC  (1C,  IN) 

21*0  CONTINUE 
250  CONTINUE 
260  CONTINUE 
C 

C 2.  STRESS  RESULTANTS  AT  NODE  J 

C 

H (1 , 1)  = CT 
H ( 1 , 2)  = ST 
H (2 , 1 ) —ST 
H (2,2)  = CT 

H (3,3)  = 1.0 

C 

DO  290  Kl=7, 10,3 
NRS  = K 1 - 1 
DO  280  I R* 1,3 
NR  = NRS+IR 
DO  280  I C= 1 , 1 2 
SA (NR+6, 1C)  =0.0 
DO  270  IN-1 ,3 
N = NRS+IN 

SA  (NR+6, 1C)  = SA  (NR+6, 1C)  - H { I R , IN)*  SA(N,IC) 

270  CONTINUE 
280  CONTINUE 
290  CONTINUE 
C 

C 3.  STRESS  RESULTANTS  AT  THE  MIDPOINT  OF  THE  ARC 

C 

H ( 1 , 1 ) = C12T 
H (1 , 2)  = S12T 
H (2, 1)  = -S12T 
H (2,2)  = C12T 
H (3.3)  * 1.0 

DO  300  1=1,3 
DO  300  K=1 ,3 
300  H (I+3.K+3)  = H (I  ,K) 

H (4,3)  - DY*  C12T  - DX*  S12T 
H (5,3)  = -DY*  S12T  - DX*  C12T 
H (6,1)  - -DY 
H (6, 2)  - DX 
C 

DO  320  I C* 1,12 
DO  310  N-1,6 
310  COL  (N)  - SA(N+6,  1C) 

DO  320  I R*1 ,6 
SA  (IR+6, 1C)  = 0.0 
DO  315  IN-1,6 

SA  ( I R+6 , I C)  = SA  (IR+6,  1C)  - H(IR,IN)*  COL(IN) 

315  CONTINUE 
320  CONTINUE 
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C**** 


6706 

c**** 

c 

1*000 

1*010 

1*020 

1*030 

1*050 

4060 

1*500 

4510 

4600 

4610 

4650 

4660 

4700 

4710 

C 


C 

c 

c 

c 

c ft** 


C**ft 


PRINT  THE  STRESS  DISPLACEMENT  TRANSFORMATION 
I F (NPAR  (10)  . LT. 1)  GO  TO  6706 
WRITE  (6,4700) 

WRITE  (6,4710)  ( (SA  ( I , J) , J=1 , 6), 1=1, 18) 

WRITE  (6,4710)  ( (SA  (I , J) ,J=7. 12) ,1-1,18) 
CONTINUE 


FORMAT  (///  24H  NODE  FLEXIBILITY  MATRIX,  //  IX) 

FORMAT  ( IX  / (6E20.8)  ) 

FORMAT  (///  22H  NODE  STIFFNESS  MATRIX,  //  IX) 

FORMAT  ( IX  / (6E20.8)  ) 

FORMAT  (///  42H  FREE  NODE  DISPLACEMENTS  (5  MEMBER  LOADS),  //  IX) 
FORMAT  (IX  / (5E20.8)  ) 

FORMAT  (23H 1 LOCAL  STIFFNESS  MATRIX,  //  IX) 

FORMAT  (//  (/6E15.6)  ) 

FORMAT  (//  17H0FIXED  END  FORCES,  //  IX) 

FORMAT  (5E20.8) 

FORMAT  (//  43HOSTRESS  CORRECTIONS  DUE  TO  FIXED  END  FORCES,  //  IX) 
FORMAT  (5E20.8) 

FORMAT  (//35H0STRESS-D I SPLACEMENT  TRANSFORMATION,  / IX) 

FORMAT  (///  (6E20.8)  ) 

RETURN 

END 

SUBROUTINE  BOUND 

CALLS?  CLAMP, STRSC 
CALLED  BY?  ELTYPE 

COMMON  /one/  A(l) 

COMMON  A (7100) 

COMMON  /ELPAR/  NPAR(l4) , NUMNP , MBAND , NELTYP, N 1 , N2 , N3, N4 , N5 , MTOT, NEQ 
COMMON  /JUNK/  LT , LH , L , I PAD , S I G (20) , I F I LL  (386) 

COMMON  /EXTRA/  M0DEX,NT8,N10SV,NT10, I F I LL2 (12) 
common  /say/  neqq,numee, loopur ,nnblock,nterms, option 
common  /what/  naxa  (10000)  , i row!  (10000)  , i col h (10000) 

I F (NPAR  (1)  . EQ.O)  GO  TO  500 

CALL  CLAMP  (NPAR  (2)  , A (N 1 ) , A (N2)  , A (N3)  .A  (N4)  , NUMNP , MBAND) 

RETURN 

WRITE  (6,2002) 

NUME=NPAR (2) 
numee=nume 
neqq=neq 

DO  800  MM-1.NUME 

CALL  STRSC  (A  (Nl)  , A (N3)  ,NEQ,0) 

WRITE  (6,2001) 

DO  800  L=LT, LH 

CALL  STRSC  (A  (Nl)  , A (N3)  ,NEQ,  1) 

WRITE  (6,3002)  MM, L,  (SIG(I)  ,1=1,2) 

STRESS  PORTHOLE 
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IF  (NIOSV.EQ.l) 

*WR  I TE  (NT  10)  MM,L,SIG  (1)  , S I G (2) 

800  CONTINUE 
RETURN 
C 

2001  FORMAT  (/) 

2002  FORMAT  (48H1B  OUNDARY  ELEMENT  FORCES/, 

1 14H  M 0 M E N T S,  //  8H  ELEMENT, 3X, 4HL0AD , 1 4X , 5HF0RCE , 

2 9X.6HM0MENT,  / 8H  NUMBER , 3X , 4HCASE , //  IX) 

3002  FORMAT  (I  8, I 7.4X.2E 15-5) 

END 

SUBROUTINE  BRICK8  (S , STR, NBRK8 , NMAT, NLD, I D , X, Y , Z,T, EE , ENU , RHO, 

A LPT, KTYPE , PR, YRE  F ,NFACE ,NUMNP) 

C 

C CALLS?  DER I V, LOAD , LOSTR , C A LB AN 
C CALLED  BY?  THREED 

C 

C STIFFNESS  SUBROUTINE  FOR  24  D.F.  ISOPARAMETRIC  HEXAHEDRON 
C LINEAR  ELASTIC  ISOTROPIC  MATERIAL 

C 1 N I NT*N I NT*N I NT'  GAUSSIAN  INTEGRATION  RULE  USED  (N I NT-1 , 2 , 3, 4) 

C 

DIMENSION  KTYPE  ( 1 ) , PR  (1) , YREF  (1 ) , NFACE  (1) 

DIMENSION  T ( 1 ) 

DIMENSION  X ( 1 ) ,Y(1)  ,Z(1)  , I D (NUMNP,  6) 

COMMON/EM/LM  (24)  ,ND,NS,  SS  (24,24) , RF  (24,4) ,XM(24) ,SA(12,24) , 

SF  (12,4)  , IFILL2  (3048) 

EQUIVALENCE  ( I S 1 , SF  (4) ) , (IS2.SF (6) ) 

DIMENSION  EE  (1) , ENU  (1)  , RHO  (1) , ALPT  (1) 

COMMON  /GASS/  XK  (4 , 4)  , WGT  (4 , 4)  , I PERM  (3) 

COMMON  /JUNK/  E 1 , E2 , E3 , DET , MLD  (4)  , KLD  (4)  , MULT  (4)  , NP  (8)  , I NP  (8)  , 

A (3,3)  ,P  (3,11)  ,B  (3,3)  , XX  (8,3)  ,Q(11)  ,DL(8)  , 

TT  (24)  , XLF  (4)  , YLF  (4)  ,ZLF  (4)  ,TLF  (4)  ,PLF  (4)  , 

REFT, I NEL, INI  NT, I MAT, I I NC,TTEMP,NEL,ML,N I NT, MAT, 

INC, I PAD, TAG, TEMP, SKIP, I , J , K, L, FAC , CC1 , CC2 , CC3, CC4 , 
G,DEN,FACT,GT,GG,C1,C2,C3,C,K1,K2, IFILL1  (64) 

COMMON  /ELPAR/  NPAR  ( 1 4) , NUMN  , MBAND , NELTYP.N 1 , N2 , N3, N4 , N5 , MTOT, NEQ 

COMMON  /EXTRA/  MODEX , NT8 , I F I LL3  (1 4) 

common  /say/  neqq , numee, 1 oopur , nnb 1 ock , nterms.opt i on 

common  /what/  naxa  (1 0000) , i rowl  (10000) , i col h (10000) 

DIMENSION  S (33,33) . STR  (12,33) 

DIMENSION  E (3,3) 

DIMENSION  I S (2) , ISP  (2) 

C 

DATA  STAR/' *'/»BLNK/'  '/ 

DIMENSION  STPTS (7 , 3) 

DATA  STPTS  /O.  , 1.  ,-l.  , 0.  , 0.  , 

0.  ,0.  ,0.  , 1.  ,-l.  , 

0.  , 0.  , 0.  , 0.  , 0.  , 

XK (1 , 1)  -0 .ODO 
XK  (2,  D-O.ODO 
XK  (3,  D-O.ODO 
XK (4, 1) -O.ODO 
XK  (1 ,2)  — .5773502691 896DO 
XK  (2,2)  — XK  (1 ,2) 

XK  (3,2) -O.ODO 


0.  , 0.  , 
0.  , 0.  , 
1.  ,-l.  / 


FILE:  PSAP  FRC  A OLD  DOMINION  UNIVERSITY 


XK  (4 , 2) =0 .ODO 

XK  (1,3)  — .77*596669241500 

XK  (2 , 3)  =0  .ODO 
XK  (3.3)  — XK(1,3) 

XK  (4,3) =0.000 
XK  (1 ,4)=-. 861 13631 159*100 
XK  (2,4) =-. 33998 10435849D0 
XK  (3.4) — XK  (2,4) 

XK  (4 , 4)  *-XK  (1,4) 

WGT  (1 , 1) *2 .ODO 

WGT  (2,1) =0 .ODO 

WGT  (3,1) =0.0D0 

WGT (4,1) =0 .ODO 

WGT  (1 , 2) =1 .ODO 

WGT  (2,2) =1 .ODO 

WGT (3, 2) =0. ODO 

WGT (4,2) *0 .ODO 

WGT ( 1 , 3) * • 5555555555555&D0 

WGT (2,3)=. 8888888888889DO 

WGT  (3,3)  =-5555555555556D0 

WGT  (4, 3) =0 .ODO 

WGT  (1,4)  = .34785*845 1375DO 

WGT  (2,4) =.652l451548625DO 
WGT (3,4) =WGT  (2,4) 

WGT  (4,4)  -WGT  (1,4) 

I PERM  (1)  -2 
I PERM  (2)  =3 
I PERM  (3)  =1 
C 

c 

c 

C ZERO  EM 
C 

WRITE  (6,3000)  NBRK8.NMAT.NLD 
DO  9 1=1 , 1058 
9 LM  ( I ) =0 

c 

C MATERIAL  PROPERTIES 
C 

WRITE  (6,1300) 

DO  1 l-l.NMAT 

READ  (5,1001)  N , EE  (N)  , ENU  (N)  , RHO  (N)  , ALPT  (N) 

1 WRITE  (6,2001)  N,  EE  (N)  , ENU  (N)  ,RHO  (N)  ,ALPT  (N) 

C***  DATA  PORTHOLE  SAVE 
IF  (M0DEX.EQ.1) 

*WR I TE  (NT8)  (EE(I).ENU(I)  ,RHO(l),ALPT(l). l-l.NMAT) 
C 

C ELEMENT  DISTRIBUTED  LOAD  CARDS 
C 

IF(NLD)  23,23,15 

15  WRITE  (6,1302) 

DO  16  1-1, NLD 

READ  (5,1002)  N.KTYPE  (N)  ,PR  (N) ,YREF  (N) .NFACE  (N) 

16  WRITE  (6,2002)  N.KTYPE  (N) , PR  (N)  ,YREF  (N) .NFACE  (N) 
C***  DATA  PORTHOLE  SAVE 
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IF  (MODEX.EQ. 1) 

*WR I TE  (NT8)  (KTYPE  (N)  ,PR(N)  ,YREF  (N)  ,NFACE  (N)  ,N=1  ,NLD) 

c 

23  READ  (5.1003)  GRAV, PLF ,TLF,XLF,YLF,ZLF 
WRITE  (6,2003)  GRAV, PLF, TLF , XLF , YLF , ZLF 
IF  (GRAV.EQ.O.)  GRAV-l.E+10 
C***  DATA  PORTHOLE  SAVE 
I F (MODEX.EQ. 1) 

*WRITE  (NTS)  GRAV, PLF, TLF, XLF, YLF, ZLF 
C 

WRITE  (6,1301) 

NEL-0 

30  READ  (5,1000)  INEL, INP, ININT, IMAT, I INC.MLD, ISP.TTEMP 
I F (I  INC.EQ.O)  I I NC= 1 
IF  (IMAT.EQ.O)  I MAT=1 
40  NEL-NEL+1 
ML= I NEL-NEL 
IF  (ML)  50,55.60 
50  WRITE  (6,4003)  INEL 
STOP 

55  DO  56  1-1,8 

56  NPO)-INP(I) 

DO  39  1-1,4 

39  MULT ( I ) - 1 
N I NT= ININT 
MAT-  I MAT 
INC-I INC 
TAG-STAR 
REFT-TTEMP 
IS  (l)-ISP(l) 

I S (2)  -I  SP  (2) 

SKIP-99999- 
IF(NINT)  33.33,57 
33  NINT-I ABS  (NINT) 

SKIP-1 . 

I F (N I NT.EQ.O)  SKIP-0. 

57  CONTINUE 

DO  59  1-1,4 

KLD ( I ) - I ABS  (MLD  (I ) ) 

I F (MLD  (I ) ) '58,58,59 

58  MULT  ( I ) =0 

59  CONTINUE 
GO  TO  62 

C 

60  DO  61  1-1,8 

61  NP  (I)  -NP  (O  + INC 
TAG-BLNK 

DO  64  1-1 ,4 

64  KLD  (l)-KLD  (I)  *MULT(I) 

C 

62  IF  (MODEX.EQ. 1)  GO  TO  540 
TEMP  - 0.0 

DO  10  1-1,8 
K-NP  (I) 

TEMP-TEMP+T  (K) 
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XX  (I  , 1)  =X  (K) 

XX  (1,2)  “Y  (K) 

10  XX  ( I , 3)  “Z  (K) 

TEMP=TEMP*0. 125 
K=MAT 

FAC  = EE  (K)  / ( (1  . - 2 . *ENU  (K) ) * (1  .+ENU  (K) ) ) 

F ACT=F  AC*ALPT  (K) * (TEMP-REFT) * (1 .+ENU (K) ) 

I F (SKIP)  70,70,63 
63  SK I P=SK I P~ 1 . 

CC1-1  .-ENU(K) 

CC2=ENU  (K) 

cc3=.5-enu(k) 

C 

DO  100  1=1,33 
DO  100  J=1 ,33 
100  S (I , J) =0 .000 
DO  110  1-1,24 
110  TT  ( I ) =0 . 

DO  120  1=1,8 
120  DL  (I) =0. 

VOLUME  = 0.0 
C 

c LOOP  OVER  NINT**3  INTEGRATION  POINTS 
C 

DO  300  LX  = 1 , N I NT 
E 1=XK (LX , N I NT) 

DO  300  LY  = 1 , N I NT 
E2=XK  (LY , N I NT) 

DO  300  LZ  = 1 ,N I NT 
E3=XK  (LZ,N I NT) 

C 

CALL  DERI  V <1 , SA) 

C 

GT=  WGT  (LX , N I NT) *WGT (LY , N I NT) *WGT (LZ , N I NT)  *DET 
VOLUME  = VOLUME  + GT 
GG=GT*RHO (MAT) 

G=GT*FAC 

C1=G*CC1 

C2=G*CC2 

C3=G*CC3 

C 

L=0 

DO  310  1=1 ,8 

DL  (I)  =DL  (I)  + GG*Q  ( I ) 

DO  310  K— 1,3 
L*L+1 

310  TT(L)=TT(L)  + GT*SA  (I  ,K) 

C 

c ADD  CONTRIBUTION  TO  STIFFNESS  MATRIX 
C 

DO  300  1=1 , 1 1 
K3  - 3*1 
K2  * K3  " 1 
K1  = K2  - 1 
U I =SA  ( I , 1) 
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VI -SA  (1,2) 

WI-SA0.3) 

DO  300  J=l , 1 1 
13  * 3*J 
L2  = L3  - 1 
LI  = L2  - 1 
UJ=SA  (J , 1) 

VJ=SA  (J , 2) 

WJ=SA  (J , 3) 

UU«UI*UJ 
VV«VI*VJ 
WW=WI*WJ 
UV=U I *VJ 
VU=VI *UJ 
UW=U I *WJ 
WU=W I *UJ 
VW=V I *WJ 
WV-WI *VJ 

S (K 1 , L 1 ) = S (K 1 , L 1)  + C1*UU  + C3* (VV+WW) 

S(K2,L2)  = S(K2,L2)  + C1*VV  + C3* (WW+UU) 

S(K3,L3)  = S(K3,L3)  + C1*WW  + C3*(UU+VV) 

S (K 1 , L2)  = S (K 1 , L 2)  + C2*UV  + C3*VU 

S(K1,L3)  = S (K 1 » L 3)  + C2*UW  + C3*WU 

S(K2,L3)  = S(K2,L3)  + C2*VW  + C3*WV 
IF  (I .EQ. J)  GO  TO  300 
S (K2 , L 1 ) = S (K2 , L 1 ) + C2*VU  + C3*UV 

S (K 3 » L 1 ) = S (K 3 > L 1)  + C2*WU  + C3*UW 

S(K3,L2)  = S(K3,L2)  + C2*WV  + C3*VW 
300  CONTINUE 
C 

C FORM  STRAIN  MATRIX 
C 

NSS=2 

IF  ( I S (2)  . EQ.O)  NSS=1 
DO  305  1*1,12 
DO  305  J=1 , 33 
305  STR  ( I , J)  *0 . 

DO  405  L= 1 , NSS 
LL*  I S (L)  +1 
E 1=STPTS  (LL,  1) 

E2*STPTS  (LL ,2) 

E3-STPTS(LL,3) 

CALL  DERI  V (2 , SA) 

L3=6*L-6 
DO  402  K-l , 1 1 
K3-3*K 
K2-K3-1 
K1-K2-1 

STR  (L3+1  * K 1 ) * SA  (K , 1) 

STR(L3+2,K2)  - SA  (K,  2) 

STR  (L3+3.K3)  “ SA(K,3) 

STR(L3+4,K1)  - SA  (K , 2) 

STR(L3+4,K2)  - SA  (K , 1) 

STR  (L3+5. K2)  - SA(K,3) 

STR  (L3+5.K3)  * SA  (K, 2) 
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STR(L3+6,K1)  = SA  (K , 3) 

4 02  STR(L3+6,K3)  = SA  (K , 1 ) 

405  CONTINUE 
NS=6*NSS 
C 

C STATIC  CONDENSATION 
C 

DO  710  M=1 ,9 
MN=34-M 
M0=MN- 1 

C STIFFNESS  MATRIX  - S 

SP=S  (MN.MN) 

DO  650  1-1, MO 
650  S (MN , I ) =S  ( I ,MN) /SP 
DO  700  K= 1 , MO 
SP=S  (MN , K) 

DO  700  J=1 ,K 

700  S (J,K)  =S  (J,K)  - SP*S(J,MN) 

C DERIVATIVE  MATRIX  - STR 

DO  710  J=1 , NS 
SP=STR  (J , MN) 

I F (SP.EQ.O.)  GO  TO  710 
DO  705  K=1 , MO 

705  STR  (J , K)  =STR  (J  , K)  - SP*S(MN,K) 
710  CONTINUE 
C 

DO  760  1=1,24 
DO  760  J=l ,24 
SS  { I , J) =S  ( I , J) 

760  SS  (J,  I)  =SS  (I  , J) 

c 

C STRAIN  TO  STRESS  MATRIX 
C 

E (1 , 1 ) =CC 1 *F  AC 
E (2*2)  =E  (1,1) 

E (3.3)  — E (1,1) 

E (1  ,2)=CC2*FAC 
E ( 1 , 3)  =E  (1 , 2) 

E (2 , 3)  =E  (1,2) 

E (2, 1)  -E  (1 ,2) 

E (3,  1)-E  (1,2) 

E (3,2)=E  (1,2) 

c- 

DO  900  1=1 ,NSS 
I I - 1 *6-6 

DO  850  J-1,3 
DO  850  K* 1,24 
SP=0. 

DO  840  L-1,3 

840  SP  = SP  + E(J,L)*STR(I  l+L.K) 
SA  (I l+J , K) =SP 
JJ=I 1+3+J 

850  SA(JJ,K)=CC3*FAC*STR(JJ,K) 

C 

C 


o o o 
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DO  860  J— 1,3 
JJ=J+3 

DO  860  K=1 , 4 

SF  (I l+J,K)=-FACT*TLF (K) 

860  SF  (I  l+JJ,K)=0. 

C 

IF  (IS  (I) .LE.O)  GO  TO  900 
LL-IS  (l)  + l 
E 1 =STPTS  (LL, 1) 

E2=STPTS  (LL , 2) 

E3=STPTS (LL , 3) 

CALL  DERIV  (4,SA) 

CALL  LOSTR  ( I S , A , B , SA , SF , I) 

C 

900  CONTINUE 
C 

70  CONTINUE 
C 

C DISTRIBUTED  LOAD 
C 

DO  410  J-1,24 
DO  410  1-1,4 
410  RF  (J, I ) =0 . 

CALL  LOAD  (KTYPE , PR , YRE F , NF ACE) 

C 

C SELF  WQT. 

C 

DO  460  11=1,8 
K=3*l I 
J=K-  1 
l=J-l 

DO  460  L=1 ,4 

RF(I.L)  = RF  (I  ,L)  *PLF  (L)  + DL  (I  I ) *XLF  (L) 

RF(J.L)  = RF  (J,L)  *PLF  (L)  + DL  (I  I)  *YLF  (L) 

460  RF(K.L)  = RF  (K , L)  *PLF  (L)  + DL  (I  I ) *ZLF  (L) 

C 

C THERMAL  LOADS 

C 

DO  470  1=1,24 
GT=TT  ( I ) *F  ACT 
DO  470  J=1 , 4 

470  RF  (I  , J)  =RF  (I  ,J)  + GT*TLF  (J) 

MASS  ARRAY 
L=0 

DUM=VOLUME*RHO  (MAT) * . 1 25/GRAV 
DO  465  1*1,8 
DO  465  J*1 , 3 
L=L+1 

465  XM(L)  = DUM 
C 

540  IJ  = 0 

DO  550  1=1,8 
I l-NP  (I) 
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DO  550  J-1,3 
I J=  I J+1 

550  LM(I  J)-ID  (I  I ,J) 

ND=24 

C 

I S 1 = 1 S (1) 

I S2=  I S (2) 

NDM=24 

CALL  CALBAN  (MBAND , ND I F , LM, XM, SS , RF , ND ,NDM,NS) 

IF (MODEX.EQ.l)  GO  TO  5&0  , 

WRITE  (1)  ND.NS,  (LM(I)  , I“1  ,ND)  , ((SA(I  ,J)  , l-l.NS)  , J*1  ,ND)  , 

1 ((SF(I,J),I-1.MS),J-1,4) 

560  IF (MODEX.EQ. 1) 

*WR I TE  (NT8)  NEL.NP.NINT, MAT, KLD, REFT, IS 
WRITE  (6,2000)  NEL,NP,NINT, MAT, TAG, KLD, REFT, IS.NDIF 


C 

C CHECK  IF  LAST  ELEMENT 
C 

I F (NBRK8-NEL)  50,600,590 
590  IF  (ML)  30,30,40 
C 
C 

600  RETURN 


C 

C 


1000  FORMAT  ( 1 2 I 5 . 4 I 2 , 2 11 , F 1 0 . 2) 

1001  FORMAT  (I5.4F10.0) 

1002  FORMAT  (2 15. 2F 10.2, I 5) 

1003  FORMAT  (F 10.2/ (4F 10.2) ) 

2000  FORMAT  (I  6, 1 X, 8 I 5, I 9, I 1 2 , 8X, A1 , 3X, 4 1 5, F9- 1 . 5X, 2 1 3. 1 8) 

2001  FORMAT  (IX, I 5. 4E 15-4) 

2002  FORMAT  ( 1 5. I 9. 2F 1 3 • 3. N 2) 

2003  FORMAT  (/////  P1#% 

35H  ACCELERATION  DUE  TO  GRAVITY  * F10.2//// 

. 38H  LOAD  FACTORS  FOR  4 ELEMENT  LOAD  CASES  // 


4F 10.3/ 

4F 1 0 . 3/ / 

4 F 1 0 . 3/ 

4 F 1 0 - 3/ 

4F  10.3/  ) 

130o'f6rMAt‘  (9HOMATERIAL  10X  1 HE  12X  2HNU  10X  3HRH0  1 IX  7HALPHA-T 


L6X  1 7HELEMENT  LOAD  CASE  / 

36X  IHA  9X  1HB  9X  1HC  9X  1 HD  / 
30H  PRESSURE  LOAD  FACTORS  . . 
30H  THERMAL  LOAD  FACTORS  . . 
30H  PERCENT  GRAVITY  IN  +X  DIRN. 
30H  PERCENT  GRAVITY  IN  +Y  DIRN. 
snu  PCDrFWT  GRAVITY  IN  +Z  DIRN. 


/ 


. 8H  number  /) 

1301  FORMAT  (30H 1 .... 8 NODE  SOLID  ELEMENT  DATA  III 

8H  ELEMENT  10X  1 5HC0NNECTED  NODES  1 7X  , 1 28H I NTEGRAT I ON 
•NPUT 1 , 7 X 1 3HELEMENT  LOADS  5X  7HELEMENT  .5X.6HSTRESS  / 

. 8H  NUMBER  3X.3&H1  2345^ 

. 7X.3HNO.  6X  3HTAG  7X  16H1  2 3 44 

. , 5X , 4HBAND  /)  „ .. 

1302  FORMAT  (/////26H  ELEMENT  DISTRIBUTED  LOADS  // 

. 52H  NUMBER  KTYPE  PR  YREF 

3000  FORMAT  ( 31  HI 8 - NODE  SOLID  ELEMENTS  III 

. 24H  NUMBER  OF  ELEMENTS 15  // 

. 24H  NUMBER  OF  MATERIALS...  , 1 5 // 


MATERIAL  I 

7 8 6X.5HORDER, 

5HTEMP.  , 6X ,6HP0 1 NTS 


FACE  ) 
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. 24H  NUMBER  OF  LOAD  TYPES..  ,15  ///) 

4003  FORMAT  (36HOELEMENT  CARD  ERROR,  ELEMENT  NUMBER9  l6) 

4004  FORMAT  ('ONUMBER  OF  DISPLACEMENTS  PER  ELEMENT  (ND)  ='.13,/, 

1 'ONUMBER  OF  STRESSES  PER  ELEMENT  (NS)  =M3,/, 

2 1 OELEMENT  STRESS-DISPL  MATRIX?') 

4005  FORMAT  (/,  (1H  , 1P10E13-4)) 

4006  FORMAT  ('OELEMENT  FIXED-NODE  STRESSES? ',/, (1H  , 1 P4E 13.4)) 

4007  FORMAT  (' ELEMENT' , I 3, ' ND-',I3,'  NS9',I3) 

4008  FORMAT  ( ( 1 P8E 1 0 . 3) ) 

C 

END 

SUBROUTINE  CLAMP  (NUMEL , I D , X , Y, Z , NUMNP.MBAND) 

C 

C CALLS?  CALBAN 

C CALLED  BY?  BOUND 

C 

COMMON/EM/LM  (24)  , ND , NS , S (24 , 24)  , P (24 , 4)  ,XM(24)  , SA  ( 1 2 , 24)  , TT  ( 1 2 , 4)  , 
1 I F I LL 1 (3048) 

DIMENSION  X(1),Y(1),Z(1),  ID  (NUMNP,  1) 

COMMON  / JUNK  / R (6)  ,RM(4)  , IF  ILL2  (410) 

COMMON  /EXTRA/  MODEX , NT8 , I F I LL3 ( 1 4) 

common  /say/  neqq , numee, 1 oopur , nnb 1 ock , nterms ,opt i on 
common  /what/  naxa  (10000) , i row]  (10000) , i colh  (10000) 

C 

WRITE  (6,2000)  NUMEL 
C 

NS=2 

ND»6 

C 

READ  (5,1005)  RM 
WRITE  (6,2005)  RM 
C***  DATA  PORTHOLE  SAVE 
IF  (MODEX. EQ.l) 

*WRITE  (NT8)  RM 
C 

C INITIALIZATION 
C 

DO  30  N I 9 1 , ND 
XM(NI)  = 0.0 
DO  20  NJ=1 , ND 
20  S (N  I , N J)  9 0.0 
30  CONTINUE 

DO  50  NK-l.NS 
DO  40  NL-1 , ND 
40  SA(NK.NL)  - 0.0 
DO  50  N I *1 , 4 
TT(NK.NI)  9 0.0 
50  CONTINUE 
C 

NE-0 

WRITE  (6,2007) 

210  KG«0 
MARK-0 
C 

200  READ  (5,1000)  NP.NI ,NJ,NK,NL,KD,KR, KN ,SD, SR, TRACE 
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IF  (TRACE. EQ.O.)  TRACE=1 .OE+IO 
IF  (KG .GT .0)  GO  TO  550 

COMPUTE  THE  DIRECTION  COSINES  OF  THE  ELEMENT*S  AXIS 
KG=KN 

I F (MODEX.EQ. 1)  GO  TO  530 
I F (NJ .EQ.O)  GO  TO  250 
X1=X  (NJ)-X(NI) 

Y1=Y  (NJ)  -Y  (Nl) 

Z1=Z  (NJ) -Z  (Nl) 

X2=X  (NL)  -X(NK) 

Y2=Y  (NL) -Y  (NK) 

Z2=Z  (NL)  -Z  (NK) 

T 1 =Y 1 *Z2~Y2*Z 1 
T2=Z1*X2-Z2*X1 
T3=X 1 *Y2-X2*Y 1 
GO  TO  260 
250  T 1 =X  (Nl)  -X  (NP) 

T2=Y (Nl)  -Y  (NP) 

T3=Z(NI)-Z(NP) 

260  XL-T1*T1+T2*T2+T3*T3 
XL=SQRT  (XL) 

I F (XL.GT. 1 .OE-6)  GO  TO  270 
WRITE  (6,3000) 

3000  FORMAT  (32HO***  ERROR  ZERO  ELEMENT  LENGTH,  / IX) 
STOP 

270  CONTINUE 
T1=T1/XL 
T2=T2/XL 
T3=T3/XL 
C 

C DISPLACEMENT  PRESCRIPTION 

C 

IF  (KD.EQ.O)  GO  TO  300 
SA(1,1)=T1*TRACE 
SA  (1 ,2) =T2*TRACE 
SA  (1 ,3) =T3*TRACE 
S (1  , 1)-T1*T1*TRACE 
S(l,  2)  =T1*T2*TRACE 
S (1 ,3) -T1*T3*TRACE 
S (2 , 2) =T2*T2*TRACE 
S (2,3)-T2*T3*TRACE 
S (3. 3) -T3*T3*TRACE 
PP-TRACE*SD 
R(1)-T1*PP 
R(2)-T2*PP 
R (3)  -T3*PP 
GO  TO  350 
300  DO  310  1=1,3 
R ( I ) = 0.0 

SA(1,I)  - 0.0 
DO  310  J=l ,3 
310  S (I  , J)  * 0.0 
C 
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C ROTATION  PRESCRIPTION 
C 

350  IF  (KR.EQ.O)  GO  TO  400 
SA  (2 , 5) =T2*TRACE 
SA  (2,4) =T1 *TRACE 
SA  (2,6) -T3*TRACE 
S (4 , 4) =T 1 *T1 *TRACE 
S (4,5) =T1 *T2*TRACE 
S (4,6) =T1*T3*TRACE 
S (5,5) =T2*T2*TRACE 
S (5,6) -T2*T3*TRACE 
S (6,6) =T3*T3*TRACE 
PP=TRACE*SR 
R (4)  =T1 *PP 
R(5)=T2*PP 
R (6)  =T3*PP 
GO  TO  450 
400  DO  410  1=4,6 
R ( I ) = 0.0 

SA  (2,  I)  =0.0 
DO  410  J=l ,6 
410  S (I , J)  = 0.0 
450  DO  500  I =1 , ND 
DO  500  J=l ,ND 
500  S (J,  I)  = S (I , J) 

DO  520  1=1 ,ND 
DO  520  J=1 ,4 
520  P(l  ,J)-R(I)*RM(J) 

530  NN  = NP 
NNI-NI 
NNJ=NJ 
NNK=NK 
NNL=NL 
NKD=KD 
NKR=KR 
SSD-SD 
SSR=SR 
TTR=TRACE 
GO  TO  560 
550  MARK=1 
555  NN-NN+KG 
NNI-NNI+KG 
560  KEL  * NE+1 

WRITE  (6,2010)  KEL.NN.NNI ,NNJ,NNK,NNL,NKD,NKR,KN,SSD,SSR,TTR 
NE-NE+1 

C***  DATA  PORTHOLE  SAVE 
IF (MODEX.EQ.l) 

*WR I TE  (NT8)  NE.NN.NNI ,NNJ,NNK,NNL,NKD,NKR,SSD,SSR,TTR 

c 

DO  600  1=1, ND 
600  LM(I)  = ID  (NN,  I) 

C 

NDM=24 

CALL  CALBAN  (MBAND , ND I F , LM, XM, S , P , ND , NDM.NS) 

IF (MODEX.EQ. 1)  GO  TO  650 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


WRITE  (1)  ND , NS , (LM  (L)  , L=1  , ND)  , ( (SA  (L , K)  , L=1  ,NS)  , K=1  , ND)  , 

1  ( (TT  (L , K)  , L=  1 , NS)  , K=1 , 4) 

C 

650  CONTINUE 

IF  (NE . EQ.NUMEL)  RETURN 
IF  (NN.LT.NP)  GO  TO  555 
IF  (MARK.EQ. 1)  GO  TO  210 
GO  TO  200 
C 

1000  FORMAT  (8 1 5 » 3F 10 .0) 

1005  FORMAT  (i+F  10.0) 

C 

2000  FORMAT  (34H1B  OUNDARY  ELEMENTS,/// 

1 27H  ELEMENT  TYPE  = 7,  / 

2 2 1 H NUMBER  OF  ELEMENTS  «,l6  ///  IX) 

2005  FORMAT  (30H  ELEMENT  LOAD  CASE  MULTIPLIERS,  //  8X , 7HCASE  (A)  , 8X , 

1 7HCASE  (B)  .8X.7HCASE  (C)  ,8X,7HCASE  (D)  ,/  4F15-4  ///  IX) 

2007  FORMAT  (53H  ELEMENT  NODE  NODES  DEFINING  CONSTRAINT  DIRECTION, 

1 3X , 38HCODE  CODE  GENERATION  SPEC  I F I ED , 6X , 

2 22HSPEC I F I ED  SPRING,  / 

3 53H  NUMBER  (N)  (N I ) (NJ)  (NK)  (NL)  , 

4 3X.38H  KD  KR  CODE  (KN)  DISPLACEMENT, 6X, 

5 22H  ROTATION  RATE,  / IX) 

2010  FORMAT  (1 X , 2 (2X , I 5)  » 2X , 4 (4X , 1 5)  , 2 (2X , I 5)  , 7X , 1 5. 2E 15  • 4 , E 1 3 • *0 
END 

SUBROUTINE  CROSS(A,B,C) 

C 

C CALLED  BY?  PLNAX 
C 

DIMENSION  A (4)  , B (4)  , C (4) 

X=A  (2)  *B  (3)  “A  (3)  *B  (2) 

Y=A  (3)  *B  (1)  -A  (1)  *B  (3) 

Z=A  (1)  *B  (2)  -A  (2)  *B  (1) 

C (4) =SQRT  (X*X+Y*Y+Z*Z) 

C (3)  =Z/C  (4) 

C (2)  =Y/C  (4) 

C (1 ) =X/C  (4) 

RETURN 

END 

SUBROUTINE  CR0SS2  (A.B.C.IERR) 

C 

C CALLED  BY  ? INP21 

C 

C 

C THIS  ROUTINE  FORMS  THE  VECTOR  PRODUCT  C = A*B  WHERE  *C* 

C IS  NORMALIZED  TO  UNIT  LENGTH 

C 

DIMENSION  A (3)  , B (3)  ,C(3) 

C 

X - A (2)  * B(3)  " A (3)  * B (2) 

Y » A (3)  * B ( 1 ) - A (1)  * B (3) 

Z = A ( 1 ) * B (2)  - A (2)  * B (1 ) 

XLN  =SQRT  (X*X+Y*Y+Z*Z) 

I ERR  * 1 

IF  (XLN.LE.l .0E-08)  RETURN 
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XLN  - 1 .0  /XLN 
C (3)  = Z * XLN 
C (2)  - Y * XLN 
C ( 1)  = X * XLN 
I ERR  * 0 
RETURN 
END 

SUBROUTINE  CSTSTR  (SCST.XST) 

C 

C CALLED  BY?  STRETR 

C 

C THIS  SUBROUTINE  FORMS  THE  STRESS/DISPLACEMENT  TRANSFORMATION 

C MATRIX  FOR  A CONSTANT  STRAIN  TRIANGLE  (CST) 

C 


C****  | N P U T S 


C 

C A , B , C AS  IN  SLST . 

C 

c****  OUTPUTS 


C 

C SCST(I.J) 

C 

C 

C 

C 


1-1. .. 3. J-l ...6.  MEMBRANE  STRESSES  S I G (XX) / ( I =1 ) , 
SIG  (YY)/(I«2)  , SIG  (XY)  / (1=3)  . IN-PLANE  NODAL 
D I SPLACEMENTS  U (1)  / (J-l)  , U (2)  / (J=2)  , U (3)  / (J-3)  , 

V ( 1 ) / ( J-4)  , V (2)  / (J=5)  , V (3)  / (J=6)  . 


COMMON  /TRIARG/ 

1 A (3)  » B (3)  ,H(3)  .HPT  (3)  , C (3.3)  .SMT(3.3)  .BUT  (3,3)  . 

2 U (6)  ,V(6)  , w (3)  ,RX(3)  ,RY(3)  ,RM(3)  ,ST(12,12) 

C 

DIMENSION  SCST(3,6)  .XST(3,6) 

C 

DO  10  1-1,3 
XST  (1  , 1+3)  * 0.0 
10  XST  (2, I ) = 0.0 
C 

AREA  = A (3)  * B (2)  - A (2)  * B (3) 

I F (AREA.LT.  1 .OE-8)  STOP  100 
DUM  = 1 .O/AREA 
C STRAIN-DISPLACEMENT 

DO  20  K=1 .3 

XST  ( 1 , K ) = B(K)*  DUM 
XST  (2 , K+3)  - A (K)  * DUM 
XST  (3, K ) = A (K) * DUM 
20  XST  (3, K+3)  = B (K) * DUM 
C STRESS-DISPLACEMENT 

DO  50  1-1,3 
DO  40  J-l ,6 
SCST(I  ,J)  = 0.0 
DO  30  K-1,3 

30  SCST(I.J)  - SCST(I.J)  + C ( I , K)  * XST(K,J) 

40  CONTINUE 
50  CONTINUE 


C 


RETURN 

END 


FILE:  PSAP  FRC  A OLD  DOMINION  UNIVERSITY 


SUBROUTINE  DECOMP  (A , B , MAX A , NEQB , MA , NBLOCK ,NWA , NTB ,NSCH,NEQ,MI) 
C 

C CALLED  BY?  SSPCEB 
C 

COMMON  /TAPES/NSTI F ,NRED,NL,NR,NT,NMASS 
DIMENSION  A (NWA)  , B (NWA)  ,MAXA (Ml ) 

C 

MA2-MA  - 2 
I F (MA2 . EQ.O)  MA2-1 
I NC=NEQB  - 1 
N 1=NL 
N2=NT 

REWIND  NSTIF 
REWIND  NRED 
REWIND  N 1 
REWIND  N2 
NSCH=0 
C 

C MAIN  LOOP  OVER  ALL  BLOCKS 

DO  600  N J= 1 .NBLOCK 
IF  (NJ.NE.1)  GO  TO  10 
READ  (NSTIF)  A 
GO  TO  100 

10  IF  (NTB.EQ.l)  GO  TO  100 

REWIND  N 1 
REWIND  N2 
READ  (Nl)  A 
C 

C FIND  COLUMN  HEIGHTS 

100  KU= 1 

KM=MI NO  (MA.NEQB) 

MAXA  (1)  =1 
DO  1 10  N=2,MI 
IF  (N-MA)  120,120,130 
120  KU=KU  + NEQB 
KK=KU 

MM=M I NO (N , KM) 

GO  TO  1 AO 
130  KU-KU  + 1 

KK=KU 

IF  (N-NEQB)  140,140,136 
136  MM-MM  - 1 

140  DO  160  K-l.MM 

IF  (A  (KK) ) 110,160,110 
160  KK-KK  - INC 

110  MAXA (N) *KK 

C 

IF  (A(l) ) 172,174,  176 
174  KK=(NJ-1)*NEQB  + 1 

IF  (KK.GT.NEQ)  GO  TO  590 
WRITE  (6,1000)  KK 
STOP 

172  NSCH=NSCH  + 1 

C 

C FACTORIZE  LEADING  BLOCK 
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176  DO  200  N=2 , NEQB 
NH-MAXA  (N) 

IF  (NH  - N)  200,200,210 
210  KL=N  + INC 
KU-NH 
K=N 
D=0. 

DO  220  KK-KL , KU , INC 

K=K  - 1 

C=A  (KK)  / A (K) 

D-D  + C*A  (KK) 

220  A (KK) -C 

A (N)  =A  (N)  - D 
C 

245  IF  (A  (N) ) 222, 221*. 230 
221*  KK=  (NJ-1)  ANEQB  + N 

IF  (KK.GT.NEQ)  GO  TO  590 
WRITE  (6,1000)  KK 
STOP 

222  NSCH-NSCH  + 1 
C 

230  IC-NEQB 

DO  240  J-l , MA2 
MJ-MAXA (N+J)  - 1C 
IF  (MJ-N)  240,240,280 
280  KU-MINO (MJ.NH) 

KN-N  + 1C 
C-0 . 

DO  300  KK-KL, KU, INC 
300  CO  + A (KK)  *A  (KK+  I C) 

A (KN)  -A  (KN)  - C 
240  IC-IC  + NEQB 

C 

200  CONTINUE 

C 

C CARRY  OVER  INTO  TRAILING  BLOCKS 

320  DO  400  NK-l.NTB 

IF  ( (NK+NJ)  .GT.NBLOCK)  GO  TO  400 
NI-N1 

IF  ((NJ.EQ.1)  .OR.  (NK.EQ.NTB))  NI-NSTIF 

READ  (Nl)  B 

ML-NK*NEQB  + 1 

MR-MI NO ( (NK+1) *NEQB,MI ) 

MD-MI  - ML 

KL-NEQB  + (NK— 1 ) *NEQB*NEQB 
N-l 
C 

DO  500  M-ML.MR 
NH-MAXA  (M) 

KL-KL  + NEQB 
IF  (NH-KL)  505.510,510 
KU-NH 
K-NEQB 
DO. 

DO  520  KK-KL.KU, INC 


510 
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520 


530 


550 


575 

540 

505 

c 

500 

c 


570 

560 

C 

400 

C 


590 

c 

600 

c 

1000 


c 


c 

c 

c 


C=A  (KK)  /A  (K) 

D=D  + C*A(KK) 

A (KK)  =C 

K=K  - 1 

B (N)  =B  (N)  - D 

IF  (MD)  500,500,530 

I ONEQB 

DO  540  J=1,MD 

MJ=MAXA (M+J)  - 1C 

IF  (MJ-KL)  5M, 550, 550 

KU=MI NO  (MJ.NH) 

KN=N  + 1C 
C=0 . 

DO  575  KK=KL , KU , INC 
C=C  + A (KK)  *A  (KK+IC) 
B(KN)=B(KN)  - C 
IC=IC  + NEQB 
MD=MD  - 1 

N=N  + 1 

IF  (NTB.NE. 1)  GO  TO  560 
WRITE  (NRED)  A.MAXA 
DO  570  1=1, NWA 
A ( I ) =B ( I ) 

GO  TO  600 
WRITE  (N2)  B 

CONTINUE 


M=N  1 
N 1=N2 
N2=M 

WRITE  (NRED)  A.MAXA 
CONTINUE 

FORMAT  (37H0***ERR0R  SOLUTION  STOP  IN  *DECOMP*,  / 12X, 

1 37HZERO  PIVOT  FOUND  DURING  FACTORIZATION,  / 12X, 

2 1 7HEQUAT I ON  NUMBER  =,  15  / IX) 


RETURN 

END 

SUBROUTINE  DERI  V (KK,D) 
CALLED  BY?  BR I CK8 , LOAD 


DIMENSION  D (12, 1) 

COMMON  /GASS/  XK  (4,4),  WGT  (4, 4),  I PERM  (3) 

COMMON  /JUNK/  R ,S  ,T  , DET, MLD  (4) , KLD  (4) .MULT  (4) ,NP  (8) , I NP  (8) , 

A (3, 3)  , P (3, 1 1)  , B (3.3)  , XX  (8,3)  ,Q0  0 .DL  (8)  , I FILL  (206) 


C 


RP=  ( 1 .+R)*.125 
RM=  (1 .-R) *. 125 
SP=1 .+S 
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SM=1 ,-S 
TP-1 ,+T 
TM= 1 .-T 

IF  (KK.EQ. 2. OR. KK.EQ.ii)  GO  TO  100 
C 

C SHAPE  FUNCTIONS 

C 

Q (1)  = RP*SM*TM 
Q (2)  = RP*SP*TM 
Q (3)  * RM*SP*TM 
Q (4)  = RM*SM*TM 
Q (5)  = RP*SM*TP 
Q (6)  = RP*SP*TP 
Q (7)  = RM*SP*TP 
Q (8)  = RM*SM*TP 
C 

C DERIVATIVES  OF  SHAPE  FUNCTIONS 

C 

100  P (1 , 1)  = SM*TM* . 1 25 
P (1 ,2)  = SP*TM*. 125 
P (1 , 3)  = ~P  ( 1 » 2) 

P(l,M  - -P(i.i) 

P (1 .5)  = SM*TP*. 125 
P (1 ,6)  = SP*TP*. 125 
P (l  ,7)  = -P0.6) 

P (1 ,8)  = -P  (1 ,5) 

P (1 .9)  = -R 
P(1  , 10)=  0. 

P (1  . 1 1)  = o. 

c 

P (2, 1)  = -RP*TM 
P (2 , 2)  = -P  (2 , 1 ) 

P (2 , 3)  - RM*TM 
P (2,4)  = -P  (2,3) 

P(2,5)  = -RP*TP 
P (2 , 6)  = -P (2,5) 

P (2 , 7)  = RM*TP 
P (2 , 8)  = -P(2,7) 

P(2,9)  =0. 

P (2 , 10)  = -S 
P (2 , 1 1 ) - 0. 

C 

P (3. 0 - -RP*SM 
P (3. 2)  - -RP*SP 
P (3. 3)  - -RM*SP 
P (3.1*)  * -RM*SM 
P (3.5)  * -P(3,D 
P (3.6)  - -P  (3.2) 

P (3, 7)  - -P  (3.3) 

P (3.8)  = -P  (3,4) 

P (3,9)  - 0. 

P (3, 10) = 0. 

P (3, 1 1) = -T 

c 


o o o 
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C JACOBIAN  MATRIX  A 
C 

DO  200  1-1,3 
DO  200  J=1 ,3 
C=0. 

DO  150  L* 1,8 

150  C = C + P(l  ,L)*XX  (L.J) 

200  A (I  , J)  = C 
C 

C INVERT  JACOBIAN 

C 

I F (KK.EQ.3)  GO  TO  500 
DO  250  1=1,3 
J = I PERM  ( I ) 

K = I PERM  (J) 

B ( I , I ) = A (J,  J)  *A  (K,K)  - A(K,J)*A(J,K) 

B ( I , J)  = A (K  , J)  *A  ( I , K)  - A ( I , J)  *A  (K , K) 

250  B (J  , I ) = A (J , K)  *A  (K , I ) - A (J , I ) *A  (K , K) 

IF  (KK.EQ.4)  GO  TO  500 

DET  = A (1 , 1)  *B  (1 , 1)  + A (1 ,2)  *B  (2,  1)  + A (1 ,3)  *B  (3.  D 
C 

C MATRIX  OF  X-Y-Z  DERIVATIVES 

DO  400  1=1,3 

DO  400  J=1 , 11 

C = 0. 

DO  350  K-1,3 

350  C = C + B (I  ,K)  *P  (K , J) 

400  D (J, I) =C/DET 
C 


c 


c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 


500  RETURN 
END 

SUBROUTINE  DER30S  (NEL , XX , B , DET, R, S ,T, N0D9, H , P, I ELD , I ELX) 
CALLED  BY  ? THDFE 


PROGRAM 

EVALUATES  STRAIN-DISPLACEMENT  MATRIX  B AT  POINT  (R,S,T) 
CURVILINEAR  HEXAHEDRON  8 TO  21  NODES 


C 

C 


DIMENSION 

DIMENSION 


XX  (3,1)  , B (6,  1)  , N0D9  ( 1 ) , H (1)  , P (3. 1) 
XJ  (3,3) ,XJI  (3.3) 
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C 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 


FIND  INTERPOLATION  FUNCTIONS  AND  THEIR  DERIVATIVES 
EVALUATE  JACOBIAN  MATRIX  AT  POINT  (R,S,T) 

COMPUTE  DETERMINANT  OF  JACOBIAN  MATRIX  AT  POINT  (R,S,T) 


CALL  FNCT  (R, S ,T, H , P , NOD9, XJ , DET, XX , I ELD , I ELX.NEL) 


COMPUTE  INVERSE  OF  JACOBIAN  MATRIX 


DUM=1 .O/DET 

X J I (1,1)  =DUM*  ( XJ  (2 , 2)  *XJ  (3 , 3) 
XJI  (2,1)  =DUM*  (-XJ  (2,  1)  *XJ  (3,3) 
XJI  (3, 1)-DUM*  ( XJ  (2,  1)  *XJ  (3,2) 
XJI  (1  ,2)«DUM*(-XJ  (1  ,2)  *XJ  (3,3) 
XJI  (2 , 2)  =DUM*  ( XJ  (1  , 1)  *XJ  (3,3) 
XJI  (3,2) -DUM* {-XJ  (1,1) *XJ  (3.2) 
XJI  (1,3)-DUM*(  XJ  (1  ,2)*XJ  (2,3) 
XJI  (2,3)  =DUM*  (-XJ  (1 , l)  *XJ  (2,3) 
XJI  (3 . 3)  =DUM*  ( XJ  (1 , 1)  *XJ  (2,2) 


- XJ  (2 , 3)  *XJ  (3,2)) 

+ XJ  (2 , 3)  *XJ  (3,  D) 

- XJ (2,2) *XJ  (3,  1) ) 

+ XJ  (1 , 3)  *XJ  (3.2)) 

- XJ(1,3)*XJ(3.D) 

+ XJ  (1,2)*XJ  (3,  D) 

- XJ  (1 ,3)*XJ  (2,2)) 
+ XJ(1,3)*XJ(2,1)) 

- XJ  (1,2)  *XJ  (2,1)) 


EVALUATE  B MATRIX  IN  GLOBAL  (X.Y.Z)  COORDINATES 


DO  130  K=1 , I ELD 
K2=K*3 

DO  115  L-1,3 
B(L,K2-2)  * 0.0 
B (L , K 2 — 1 ) = 0.0 

115  B(L,K2  ) = 0.0 

DIRECT  STRAINS  (1-EXX,  2=EYY , 1=111) 

DO  120  1=1,3 

B (1  , K2-2)  = B ( 1 , K2-2)  + XJI  (1,1)*  P ( I , K) 

B (2 , K2- 1 ) = B (2 , K 2 — 1 ) + XJI  (2,1)*  P(I,K) 

120  B(3,K2  ) = B (3 , K2  ) + XJI  (3 » I ) * P ( I , K) 

SHEAR  STRAINS  (1»=EXY,  5*EYZ,  6=EZX) 


B (k,K2*2) 
B (4, K2- 1 ) 
B (5, K2- 1 ) 
B (5 , K2  ) 
B (6, K2-2) 
130  B(6,K2  ) 


B (2.K2-1) 
B(l,K2-2) 
B (3, K2  ) 
B (2.K2-1) 
B(3,K2  ) 

B ( 1 , K2-2) 


RETURN 


C 


END 

SUBROUTINE  DISPLR  ( I D , F , F I , X , NEQB , NF , NDS , NUMNP , NBLOCK , NSB) 
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C CALLS?  DISPLY 

C CALLED  BY?  H I STRY 

C 

DIMENSION  ID  (NUMNP.6) ,F  (8, NF) ,F I (NSB  ,NF) ,X  (NF ,NDS) 

COMMON  /JUNK/  D (8)  , DDT,T  I ME  , DD , XUM,  DM  (8)  ,TM  (8)  ,NP,  I C (6)  , L , I I , 
1 MSB ,NS,NE,N,M,J,K,MM,KD  (3,8) , IEQ.NRD, IFILL1  (33  0 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL2  (14) 

COMMON  / DYN  / NT, NOT, DAMP, DT, I F I LL3  (6) 

C 

C EQUATION  NUMBERS  OF  SELECTED  DISPLACEMENT  COMPONENTS 

C 

I F (MODEX.EQ. 0 GO  TO  50 
REWIND  9 
REWIND  8 
READ  (8)  ID 
50  L=0 
NUM=0 

READ  (5,2000)  KKK.ISP 
WRITE  (6,1005) 

100  READ  (5,2000)  NP, 1C 
WRITE  (6,2001)  NP.IC 

I F (MODEX.EQ. 1 .AND.  NP.EQ.O)  GO  TO  210 
I F (MODEX.EQ. 1)  GO  TO  100 
I F (NP.GT.O)  GO  TO  1 10 
I F (L.EQ.O)  GO  TO  200 
WRITE  (9)  KD.L 
NUM=NUM+1 
GO  TO  200 
110  DO  150  1*1,6 
I 1 = 1 C (I) 

I F (I  I . EQ.O)  GO  TO  100 
120  L=L+1 

KD  (1 ,L) =NP 
KD  (2,L) =1  I 
KD  (3,L)=ID  (NP,  I I) 

IF  (ID  (NP , I I)  . LE  .0)  L=L- 1 
IF  (L.LT.8)  GO  TO  150 
WRITE  (9)  KD.L 
NUM=NUM+1 
L=0 

150  CONTINUE 
GO  TO  100 
C 

C APPROPRIATE  MODE  SHAPE  COMPONENTS 
C 

200  I F (NUM. EQ.O)  RETURN 
210  WRITE  (6,4000)  KKK, ISP 
I F (MODEX.EQ. 1)  RETURN 
REWIND  3 
REWIND  9 
REWIND  7 
READ  (7) 

NE-NSB 

NS=NE+1 -NEQB 
DO  300  1=1 , NBLOCK 
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READ  (7)  ((FI  (J,K)  ,J-NS,NE)  ,K-1,NF) 

NS=NS-NEQB 
300  NE-NE-NEQB 
C 

DO  400  N-l.NUM 
READ  (9)  KD , L 
C 

DO  350  1-1, L 
I I *KD  (3,1) 

DO  350  J-l.NF 
350  F (I  ,J)=FI  (I  I ,J) 

400  WRITE  (3)  L.KD.F 
C 

C COMPUTE  AND  OUTPUT  HISTORY  OF  VALUES 
C 

410  DT»NOT*DT 
C 

CALL  DISPLY  (X, F ,NF ,NDS,NUM, 1 ,KKK, 2, I SP) 

C 

900  RETURN 
C 

1005  FORMAT  (23H 1 0 I SPLACEMENT  COMPONENT,/  22H  TIME  HISTORY  REQUESTS,// 

1 3X,4HN0DE,3X,24HN0DAL  DEGREES  OF  FREEDOM,/  7H  NUMBER, 3X, 6 (}X, 

2 1H*)  , / IX) 

2000  FORMAT  (7  I 5) 

2001  FORMAT  ( I 7 . 3X, 6 1 4) 

4000  FORMAT  (//  25H  CODE  FOR  OUTPUT  TYPE  =,  12/ 

1 3X.19HEQ.1,  HISTORY  TABLE,  / 

2 3X.18HEQ.2,  PRINTER  PLOT,  / 

3 3X.17HEQ.3,  MAXIMA  ONLY,  / 

4 25H  PRINTER  PLOT  SPACING  =,  12  / IX) 

C 

END 

SUBROUTINE  DISPLY  (X , F , NF ,NDS , NUM, NN , KKK , I SD , I SP) 

C 

C CALLS?  ELOUTH , PPLOT 

C CALLED  BY?  D I SPLR , STRSD 1 

C 

C SUBROUTINE  TO  PRINT  RESPONSE  TABLES,  TO  PRODUCE  PRINTER  PLOTS 
C OF  DISPLACEMENT  OR  STRESS  COMPONENTS,  OR  TO  RECOVER  MAXIMA  ONLY 
C 

C ISD  - 1,  STRESSES  KKK  - 1,  PRINT  RESPONSE  TABLES  + MAXIMA 

C ISD  * 2,  DISPLACEMENTS  KKK  - 2,  PRINTER  PLOTS  + MAXIMA 

C KKK  - 3,  RECOVER  MAXIMA 

C 

DIMENSION  X (NF ,NDS) ,F  (8,NF)  , NUM  (NN) 

COMMON  / JUNK  / KD  (3, 8)  ,TM  (8)  , DM  (8)  , D (8)  , I F I LL 1 (358) 

COMMON  / DYN  / NT, NOT, DAMP, DT, I F I LL2  (6) 

COMMON  / ELPAR  / NPAR  (14) , I F I LL3  (10) 

C 

REWIND  3 
REWIND  4 
READ  (4)  X 
C 

DO  900  N-l.NN 
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REWIND  2 
REWIND  9 
MM-NUM  (N) 

C 

IF  (ISD.EQ.2)  GO  TO  90 
READ  (3)  NPAR 
MTYPE-NPAR (1) 

90  I F (MM.EQ.O)  GO  TO  900 
C 

DO  600  M=1 ,MM 
IF  (ISD.EQ.2)  GO  TO  70 
READ  (3)  L , KD , F , NS 
GO  TO  80 

70  READ  (3)  L.KD.F 
80  GO  TO  (100,300,200) , KKK 
C 

C PRINT 

C 

100  I F (ISD.EQ. 1)  GO  TO  130 
WRITE  (6,1000)  M 
GO  TO  140 

130  CALL  ELOUTH  (KD , L , MTYPE , M, NS) 

GO  TO  300 

140  WRITE  (6,2001)  (KD  (1  , I ) , KD  (2 , I ) , I - 1 , L) 
GO  TO  300 
C 

c MAX  I MUMS 

C 

200  IF  (M.GT.l)  GO  TO  300 
IF  (ISD.EQ. 1)  GO  TO  230 
WRITE  (6,1002) 

WRITE  (6,5001) 

GO  TO  300 

230  WRITE  (6,2002)  MTYPE 
WRITE  (6,4001) 

C 

C COMPUTE  HISTORY 

C 

300  DO  320  I =1 , L 
TM  ( I ) =0 . 

320  DM(l)-0. 

T I ME-0 . 

C 

DO  500  K-1 , NDS 
TIME-TIME  + DT 
DO  450  1-1 ,L 
DD-0 . 

DO  440  J— 1 , N F 

440  DD  = DD  + F (I  , J)  *X  (J,K) 

C 

AD-ABS  (DD) 

I F (AD-DM  ( I ) ) 450,450,445 
445  DM  (I ) -AD 
TM  ( I ) -T I ME 


FILE:  PSAP  FRC  A OLD  DOMINION  UNIVERSITY 


450  D ( I ) =DD 

GO  TO  (480,490,500)  , KKK 
C 

480  WRITE  (6,1004)  T I ME , (D  ( I ) , I = 1 , L) 

GO  TO  500 
C 

490  WRITE  (9)  D 
C 

500  CONTINUE 
C 

GO  TO  (510,520,530) , KKK 
C 

510  WRITE  (6,1005)  (DM  (I ) , I =1 , L) 

WRITE  (6,1006)  (TM  ( I ) , I =1 , L) 

GO  TO  600 
C 

520  WRITE  (2)  KD , DM,TM, L 
GO  TO  600 
C 

530  WRITE  (6,1007)  (KD  (1  , I)  ,KD  (2,  I)  , DM  ( I ) ,TM(I)  , 1 = 1 ,L) 

C 

600  CONTINUE 
C 

C PLOT  SET  OF  VALUES 
C 

I F (KKK.NE.2)  GO  TO  900 
REWIND  2 
REWIND  9 
DO  800  M= 1 , MM 
GO  TO  (610,620) , ISD 
C 

610  WRITE  (6,4000)  MTYPE.M 
WRITE  (6,4001) 

GO  TO  630 
C 

620  WRITE  (6,5000)  M 
WRITE  (6,5001) 

C 

630  CALL  PPLOT  (2.9.NDS, ISP) 

C 

800  CONTINUE 
900  CONTINUE 
C 
C 

RETURN 

C 

1000  FORMAT  (50H1D  ISPLACEMENT  TIME  HISTORY,// 

1 1 3H  OUTPUT  SET  «,I4,  //  14X,27H*N0DE  NUMBER*  - (COMPONENT  , 

2 7HNUMBER) , IX) 

1002  FORMAT  (38HID  ISPLACEMENT  MAXIMA,  //IX) 

1004  FORMAT  (F 12.5.2X, 1P8E 12 .3) 

1005  FORMAT  (/  24H  MAXIMUM  ABSOLUTE  VALUES,  //  8H  MAX  I MUM, 6X , 1 P8E 1 2 . 3) 

1006  FORMAT  (5H  T I ME , 9X , 1 P8E  1 2 . 3) 

1007  FORMAT  (18, 12X, 13, 1P2E14.4.7X.2HNA) 

2001  FORMAT  (8X, 4HT I ME , 2X , 8 (4X , 1 4 , 2H-  (, I 1 , 1 H) ) / IX) 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


2002  FORMAT  (4&H1S  TRESS  COMPONENT  MAXIMA,// 

1 22H  ELEMENT  TYPE  NUMBER  =,  13,  //  IX) 

4000  FORMAT  (51H1N0RMALIZED  STRESS  HI  STORY, 3X, 

1 7HP  L 0 T,  //  22H  ELEMENT  TYPE  NUMBER  = . 13  / 

2 22H  OUTPUT  SET  NUMBER  =,  1 3 //  IX) 

4001  FORMAT  (8H  ELEMENT, 9X , 6HSTRESS , 7X , 7HMAX I MUM, 7X , 7HT I ME  AT.5X, 

1 4HPL0T , / 8H  NUMBER, 6X,9HC0MP0NENT,9X,5HVALUE,7X,7HMAXIMUM,3X, 

2 6HSYMB0L,  / IX) 

5000  FORMAT  (46H1N  ORMALIZED  DISPLACEMENT^, 

1 23HH  I S T 0 R Y P L 0 T,  //  22H  OUTPUT  SET  NUMBER  *,  I3//1X) 

5001  FORMAT  (4X.4HN0DE.3X, 12HDISPLACEMENT,7X,7HMAXIMUM,7X,7HTIME  AT, 

2 5X.4HPL0T,  / 8H  NUMBER, 6X,9HC0MP0NENT,9X,5HVALUE,7X,7HMAXIMUM, 

3 3X.6HSYMB0L,  / IX) 

C 

END 

FUNCTION  DOT  (A , B) 

C 

C CALLED  BY?  PLNAX 

C 

DIMENSION  A (4)  ,B(4) 

DOT=A  (1)  *B  (1)  +A  (2)  *B  (2)  +A  (3)  *B  (3) 

RETURN 

END 

SUBROUTINE  EIGSOL  (DL , RTOLV, AR , BR, VEC , VL , VR, D , XM, NF , NV, NBLOCK , 
1NEQB.N ITE , I FPR , N I TEM, RTOL , IFSS.COFQ) 

REAL  T1.T2 
C 

C CALLS?  JACOBI 

C CALLED  BY?  SSPCEB 

C 

COMMON  /TAPES/NST I F , NRED , NL , NR , NT, NMASS 

D I MENS  I ON  AR  (NV,NV)  , BR  (NV.NV)  , VEC (NV.NV)  ,VL (NEQB.NV)  , VR (NEQB.NV) 

D I MENS  I ON  D (NV)  , DL  (NV)  , RTOLV  (NV)  , XM  (NEQB) 

C 

T0LJ=1 . 0 E — 1 2 
REWIND  NMASS 
REWIND  NT 
REWIND  NR 
C 

C FIND  PROJECTIONS  OF  MASS  AND  STIFFNESS  OPERATORS 
DO  100  1=1, NV 
DO  100  J=l , NV 
AR ( I , J) =0 .0 
100  BR  (I  , J)  =0.0 

DO  200  N*1 .NBLOCK 
BACKSPACE  NL 
READ  (NL)  VL 
BACKSPACE  NL 
READ  (NR)  VR 
READ  (NMASS)  XM 
DO  220  1*1, NV 
DO  220  J=l , NV 
ART=0 .0 

DO  230  K-l.NEQB 
ART=ART+VL (K, I ) *VR (K , J) 


230 
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220  AR  (I  , J)  =AR  (I  , J)+ART 
DO  2kO  1=1 , NEQB 
XMM=XM  ( I ) 

DO  2kO  J-l ,NV 
2kO  VR (I , J) =VL  (I , J) *XMM 
WRITE  (NT)  VR 
DO  260  1=1, NV 
DO  260  J=l , NV 
BRT=0 .0 

DO  280  K= 1 , NEQB 
280  BRT=BRT+VL  (K , I ) *VR  (K , J) 

260  BR  ( I , J) =BR  ( I , J) +BRT 
200  CONTINUE 

DO  290  1 = 1 , NV 
DO  290  J=1 , I 
AR  (I  , J)=AR  (J,  I) 

290  BR  ( I , J) =BR  (J , I ) 

C 

C SOLVE  EIGENVALUE  PROBLEM 

IF  (IFPR.EQ.O)  GO  TO  293 
WRITE  (6,1010) 

DO  292  1=1, NV 

292  WRITE  (6,1000)  (AR  (I , J) , J=1 ,NV) 

WRITE  (6,1020) 

DO  29^  1=1, NV 

291*  WRITE  (6,1000)  (BR  (I  , J)  , J=1  ,NV) 

C***  CALL  TTIME  (Tl) 

C 

293  CALL  JACOBI  (AR,BR,VEC,D,VL,NV,TOLJ, I FPR) 
DO  295  J-1.NV 

I F (BR  (J, J)  . GT.O.)  GO  TO  291 
WRITE  (6,1070) 

WRITE  (6,1010) 

DO  501  L 1 = 1 , NV 

501  WRITE  (6,1000)  (AR  (L 1 , L2) , L2= 1 , NV) 

WRITE  (6,1020) 

DO  502  L 1=1 , NV 

502  WRITE  (6,1000)  (BR (L 1 , L2) , L2=l , NV) 

STOP 

291  XMM=SQRT  (BR  (J , J) ) 

00  295  K-l.NV 

295  VEC (K, J) =VEC  (K, J) /XMM 
C 

IF  (IFPR.EQ.O)  GO  TO  310 
C***  CALL  TTIME  (T2) 

T3-T2  - Tl 
WRITE  (6,1080)  T3 
WRITE  (6,1030) 

WRITE  (6,1010) 

DO  296  1=1, NV 

296  WRITE  (6,1000)  (AR  (I , J) , J-l . NV) 

WRITE  (6,1020) 

DO  298  1=1, NV 

298  WRITE  (6,1000)  (BR (I , J) , J=1 ,NV) 

C 
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C ARRANGE  EIGENVALUES 
310  NV1=NV- 1 
440  IS=0 

DO  400  1=1, NV1 

IF  (D  (1  + 1)  .GE.D(I))  GO  TO  400 
IS=IS+1 

BT=BR (1+1 , 1+1) 

DT-D  (1  + 1) 

BR  (1  + 1 , 1 + 1)  =BR  (I  ,1) 

D (1+1)  -D  (I) 

BR ( I , I ) =BT 
D ( I ) =DT 
DO  420  K=1 , NV 
TEMP=VEC  (K, 1 + 1) 

VEC (K, 1 + 1) =VEC  (K, I) 

420  VEC (K, I) =TEMP 
400  CONTINUE 

IF  (IS.GT.O)  GO  TO  440 
C 

C CHECK  FOR  CONVERGENCE 
DO  300  1=1, NV 
IF  (D  (I)  .GT.O.)  GO  TO  302 
WRITE  (6,1090) 

STOP 

302  D I F=ABS  (DL(I)-D(I)) 

300  RTOLV  ( I ) =D I F/D  ( I ) 

IF  (IFPR.EQ.O)  GO  TO  304 
WRITE  (6,1040) 

WRITE  (6,1000)  (RTOLV  (I)  , 1 = 1 , NV) 
304  CONTINUE 

DO  305  L=1,NF 

IF  (D  (L)  .LT.COFQ)  GO  TO  305 
IF  (RTOLV  (L)  .GT.RTOL)  GO  TO  306 
NF=L 

GO  TO  306 

305  CONTINUE 

306  DO  320  1=1, NF 

IF  (RTOLV(I)  .GT.RTOL)  GO  TO  340 
320  CONTINUE 

WRITE  (6,1050)  NF.RTOL 
N I TE=N I TEM 
GO  TO  350 

340  IF  (NITE.EQ.NI TEM- 2)  IFPR-1 

IF  (NITE.LT.NITEM  ) GO  TO  3&0 
WRITE  (6,1060) 

IFSS-1 

350  DO  354  l-l.NV 

DL  (l)=D  (I) 

354  D (I)  =SQRT  (D  (1) ) 

M=NT 

NT-NL 

NL=M 

M=NR 

NR=NL 

NL=M 
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REWIND  NR 

WRITE  (NR)  (D  (I)  , 1 = 1 ,NF) 

GO  TO  430 
C 

C CALCULATE  APPROXIMATE  EIGEN  DIRECTIONS 
360  DO  410  1-1, NV 

410  DL  ( I ) -D  ( I ) 

REWIND  NR 
430  REWIND  NT 

DO  460  N= 1 , NBLOCK 
READ  (NT)  VR 
DO  480  J-l.NV 
DO  480  1=1 ,NEQB 
TEMP-0.0 
DO  500  K-l ,NV 

500  TEMP=TEMP+VR  (I ,K) *VEC  (K, J) 

480  VL  ( I , J) -TEMP 

460  WRITE  (NR)  VL 
C 

RETURN 

1000  FORMAT  (1H  , 12E11.4) 

1002  FORMAT  (1H0.6E20. 14) 

1010  FORMAT  (10H0MATRIX  AR  ) 

1020  FORMAT  (10H0MATRIX  BR  ) 

1030  FORMAT  (40H0AR  AND  BR  AFTER  JACOBI  D I AGONAL  I ZATI ON  ) 

1040  FORMAT  (52HORELAT I VE  TOLERANCE  REACHED  ON  EIGENVALUES  IS  NOW  ) 
1050  FORMAT  (33HOCONVERGENCE  ACHIEVED  IN  *EIGSOL*.  / 

1 27H  NUMBER  OF  EIGENVALUES  - , 13  / 

2 27H  RELATIVE  TOLERANCE  = , E12.4  //  IX) 

1060  FORMAT  (52HOWE  ACCEPT  THE  CURRENT  EIGENVALUE  APPROXIMATIONS  ) 
1070  FORMAT  (37HO***ERROR  SOLUTION  STOP  IN  *EIGSOL*,  / 12X, 

1 39HNEGAT I VE  DIAGONAL  ELEMENT  IN  MATRIX  BR.,  //  IX) 

1080  FORMAT  (28HOTIME  FOR  JACOBI  ITERATION  F10.4) 

1090  FORMAT  (37HO***ERROR  SOLUTION  STOP  IN  *EIGSOL*,  / 12X, 

1 44HINADMISSIBLE  NEGATIVE  EIGENVALUE  CALCULATED.,  / IX) 

C 

END 

SUBROUTINE  ELAW  (NUMTC , EE , E , C , P, ALP) 

C 

C CALLS?  POSINV 

C CALLED  BY?  PLNAX 

C 

COMMON  /JUNK/  MAT, NT, TEMP, REFT, BETA ,TAU  (4) , D (4,4) , CC  (4 , 4) 

1 ,XX(4)  , IFILL1  (342) 

COMMON  /ELPAR/  NPAR  ( 1 4) , I F I LL2  (10) 

DIMENSION  E (NUMTC,  1 1 , 1)  , EE  (10)  , C (4,4)  , P (4)  , ALP  (4) 

C 

C STRESS-STRAIN  LAW  IN  N-S-T  SYSTEM 

C 

IF  (NT.NE.l)  GO  TO  220 
DO  210  KK-1 , 10 
210  EE  (KK)-E  (1  ,KK+1  , MAT) 

GO  TO  260 
220  DO  230  1=2, NT 
Tl-E (1-1 , 1 .MAT) 
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T2=E (I , 1 .MAT) 

IF  (T2.GE.TEMP)  GO  TO  240 
230  CONTINUE 
240  CONTINUE 

R I = (T2-TEMP)  / (T2-T1) 

RJ=  (TEMP-T1)  / (T2-T1) 

DO  250  KK-1,10 

250  EE (KK)-E (1-1 ,KK+1 , MAT) *R I +E ( I , KK+1 , MAT) *RJ 
260  CONTINUE 

DO  265  I 1*1,4 
DO  265  KK-1 ,4 
C(l  I ,KK)=0. 

265  D (I  l<KK)=0. 

C 

C (1 , 1)  = 1.0/  EE  (1 ) 

C (2 , 2)  = 1.0/  EE  (2) 

C (3, 3)  = 1-0/  EE  (3) 

C (1.2)=  -EE  (4)  /EE  (2) 

C(l, 3)-  -EE  (5) /EE  (3) 

C (2, 3)  = -EE  (6) /EE  (3) 

C (2, 1)  = C ( 1 ,2) 

C (3,  1)  = C (1 , 3) 

C (3 . 2)  = C (2 , 3) 

C (4,4)  = 1.0/  EE  (7) 

C 

DO  270  M-1,3 
ALP  (M)  = EE  (M+7) 

270  CONTINUE 

ALP  (4)  = 0.0 
C 

C ROTATE  MATERIAL  PROPERTIES  TO  R-Z-T  SYSTEM 

C 

I F (BETA. EQ. 0.0)  GO  TO  500 
ANG=BETA/57- 2957795 
SS=S I N (ANG) 

ACC=COS  (ANG) 

S2=SS*SS 

C2=ACC*ACC 

SC=SS*ACC 

C SET  D FOR  S I G (0)  =D*S  I G (G) 

D (1 , 1 ) =C2 
D (1 ,2)=S2 
D (1 ,4)=2.*SC 
D (2 , 1 ) =S2 
D (2 , 2)  =C2 
D (2,4)  *-D  (1,4) 

D (3.3) “1 *0 
D (4, 1)  — SC 
D (4,2)  — D (4,1) 

D (4,4) *C2-S2 
C 

C FORM  (D) TRANSPOSE  * (0 
C 

DO  300  1=1,4 
DO  300  J=1 ,4 
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SUMO. 

00  280  M=  1 , I* 

280  SUM-SUM+D  (M, I) *C  (M,J) 

300  CC  (I , J) =SUM 
C 

C FORM  (D)  TRANSPOSE  * (C)  * (D) 
C 

DO  350  1 = 1,1* 

DO  350  J=l ,4 
SUMO. 


DO  330  M=l,4 

330  SUM=SUM+CC  ( I , M)  *D  (M,  J) 

C (I  , J)  =SUM 
350  C (J, I ) =SUM 

c 

C TRANSFORM  THERMAL  EXPANSION  COEFFICIENTS 

C 

XX  (1)=C2*ALP(1)+S2*ALP(2) 

XX  (2)=S2*ALP  (1)+C2*ALP  (2) 

XX  (3)  -ALP  (3) 

XX  (4)  =2 .*SC*  (ALP  (1) -ALP  (2) ) 

DO  L30  1=1  ,i* 

1*30  ALP  (I)  = XX  (I) 

C 

C INVERT  THE  STRAIN-STRESS  LAW 

C 


c 

c 

c 

c 


500  CALL  POSINV  (C,4,4) 

MODIFY  FOR  THE  CONDITION  OF  PLANE  STRESS 
IF  (NPAR(5)  .NE.2)  GO  TO  660 


C(l,l)=  C (1 , 1)  - 
C (1 ,2)  = C ( 1 , 2)  - 
C (1 ,4)  = C (1 ,4)  - 
C (2 , 2)  = C (2 , 2)  — 
C (2 , 4)  = C (2 , 4)  - 
C (4, 4)  = C (4,4)  - 
C 

DO  650  1=1 ,4 
DO  600  J=l ,4 
600  C (J , I ) =C  ( I , J) 

C ( 1 , 3)  -0. 

650  C(3,l)0. 

C 


C (3. 1)  * C (1 , 3)  /C  (3. 3) 
0 (3 » 2)  * C (1 , 3)  /C  (3, 3) 
C (3.4)  * C (1 , 3)  /C  (3, 3) 
0(3.2)*  C (2,3)  /C  (3,3) 
C (3,4)  * C (2,3)/C  (3,3) 
CO,1*)*  C (4, 3)  /C  (3, 3) 


C RESTRAINED  THERMAL  STRESSES 
C 

660  DO  670  1=1,4 
P(l)  = 0. 

DO  670  M= 1 ,4 

670  P ( I ) =P  ( I ) +C  ( I ,M)*ALP(M) 

C 


700  RETURN 
END 

SUBROUTINE  ELOUTH  (KD, L, I ELT.M.NS) 
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C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 


c 


c 

c 

c 

c 


CALLED  BY?  DISPLY 


KD(1,I)  - ELEMENT  NUMBERS  IN  THIS  OUTPUT  SET 

(I  RANGES  FROM  1 TO  L) 

KD  (2 , I ) = ELEMENT  COMPONENT  NUMBERS 

L * NUMBER  OF  ELEMENT  COMPONENT  NUMBERS  PER  LINE  OF 

OUTPUT  (8  MAXIMUM) 

IELT  = ELEMENT  TYPE  (1,2 12) 

M = OUTPUT  SET  NUMBER 

NS  = MAXIMUM  NUMBER  OF  STRESS  COMPONENTS  ASSOCIATED 

WITH  THE  IELT-TH  ELEMENT  TYPE 

DIMENSION  KD  (3. 1)  s 

DIMENSION  SY  (12,6)  ,SZ  (12,7)  , LAB  (12)  , HD  (12,4)  ,HH(8,2) 


ELEMENT  COMPONENT  LABELS 


DATA  SY(  1,1)  /3H  / 

DATA  SY  ( 2,1)  /3HPK/,  SY  ( 2,2)  /3HV2(/,  SY  ( 2,3)  /3HV3(/, 
1 SY  ( 2,4)  /3HT1  (/,  SY  ( 2,5)  /3HM2(/,  SY  ( 2,6)  /3HM3  (/ 

DATA  SY  ( 3,1)  /3HPX(/,  SY ( 3.2)  /3HVY  (/ , SY  ( 3.3)  /3HVZ  (/, 

1 SY ( 3,4)  /3HTX (/ , SY  ( 3,5)  /3HMY  (/.  SY  ( 3.6)  /3HMZ  (/ 

DATA  SY  ( 4,1)  /3HV  -/,  SY  ( 4,2)  /3HU  -/ , SY  ( 4,3)  /3HT  -/, 

1 SY ( 4,4)  /3HUV-/ 

DATA  SY  ( 5,1)  /3HXX-/,  SY ( 5.2)  /3HYY-/,  SY  ( 5.3)  /3HZZ-/, 

1 SY  ( 5,4)  /3HXY-/,  SY  ( 5,5)  /3HYZ-/,  SY  ( 5,6)  /3HZX-/ 

DATA  SY  ( 6,1)  /3HXX-/.  SY ( 6.2)  /3HYY-/ , SY ( 6,3)  /3HXY-/ 
DATA  SY ( 7,1)  /3HBDR/ 

DATA  SY  ( 8,1)  /3HSXX/,  SY  ( 8,2)  /3HSYY/ , SY  ( 8,3)  /3HSZZ/, 

1 SY  ( 8,4)  /3HSXY/,  SY  ( 8,5)  /3HSYZ/,  SY  ( 8,6)  /3HSZX/ 

DATA  SY  (12, 1)  /3HPX(/,  SY  (12,2)  /3HVY(/,  SY  (12,3)  /3HVZ(/, 
1 SY  (12,4)  /3HTX  (/.  SY  (12,5)  /3HMY(/,  SY  (12.6)  /3HMZ  (/ 


DATA 

DATA 

DATA 

DATA 


1 


DATA 

DATA 

DATA 

DATA 


SZ( 

SZ( 

SZ( 

SZ( 

SZ( 

SZ( 


1,1) 

2,1) 

3.D 

4,1) 

4,4) 

5.D 


SZ(  6,1) 
SZ(  7.1) 
SZ(  8,1) 

1 SZ(  8,4) 

2 SZ(  8,7) 
DATA  SZ  (1 2 , 1) 


/3HP/A/, 
/3HI)  /, 
/3HI)  /, 
/3HSO  /, 
/3HS3  /, 
/3HSL1/, 
/3HS/R/, 
/3HY-F/, 
/3H  (0)/, 
/3H (3) / » 
/3H  (6)  / 
/3HI)  /, 


sz( 

SZ( 

SZ( 

sz( 

sz( 

sz( 

sz( 

SZ  ( 

sz( 

SZ  ( 


1,2) 

2,2) 

3.2) 

4.2) 

4.5) 

5.2) 

6.2) 

7.2) 

8.2) 

8.5) 


/3HP  / 
/3HJ)  / 
/3HJ)  / 
/3HS1  /. 
/3HS4  / 
/3HSL2/ 
/3HM/R/ 
/3HY-M/ 
/3H  ( 1) /. 
/3H(4)/, 


SZ  ( 4,3)  /3HS2  /, 


SZ  ( 

sz( 


8,3) 

8,6) 


/3H (2) / , 

/3H  (5)/. 


SZ  (12,2)  /3HC)  /,  SZ  (12,3)  /3HJ)  / 


DATA  LAB  /I ,6, 6, 4,6, 3. 1 ,6, 0,0, 0,6/ 


ELEMENT  TYPE  LABELS 

DATA  HD  ( 1,1) /6HT  R U /,HD(  1,2)/6HS  S /,HD(  1,3)/6H  / 

DATA  HD  ( 2.D/6HB  E A /,HD(  2,2)/6HM  /,HD(  2,3)/6H  / 

DATA  HD  ( 3,1) /6H2/D  /,HD(  3,2) /6HP  L A /,HD(  3.3)/6HN  A R / 

DATA  HD  ( 4,1)/6HA  X I /,HD(  4,2) /6HS  Y M /, HD ( 4,3) /6HM  E T / 
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DATA  HD ( 5,1)/6H3/D  / , HD ( 5,2)  /6HB  R I / , HD ( 5,3) /6HC  K / 

DATA  HD ( 6, 1) /6HP  L A /,HD(  6,2) /6HT  E / /,HD(  6,3) /6HS  HE/ 

DATA  HD  ( 7.D/6HB  0 U /,HD(  7,2)  /6HN  D A /,HD(  7,3) /6HR  Y / 

DATA  HO  ( 8.D/6HT  H I /,HD(  8,2)/6HC  K /,HD(  8,3)/6HS  HE/ 

DATA  HD(12,  D/6H3/D  /,HD  (12, 2) /6HP  I P /,HD  (12, 3) /6HE  / 

C 

DATA  HD ( 1 , 4) /6H  / 

DATA  HD  ( 2,4)/6H  / 

DATA  HD  ( 3.M/6H  / 

DATA  HD  ( 4,4) /6HR  I C / 

DATA  HD  ( 5,4)  /6H  / 

DATA  HD  ( 6,4) /6HL  L / 

DATA  HD  ( 7,4) /6H  / 

DATA  HD  ( 8,4)/6HL  L / 

DATA  HD(12,4)/6H  / 

C 

C DETERMINE  ADJUSTED  ELEMENT  TYPE  FOR  TABLE  SELECTION 
C 

IF(L.LT.l)  RETURN 
KEL  = I ELT 

I F (I ELT.EQ. 12  .AND.  NS.EQ.12)  KEL  = 3 
IF  (I  ELT.EQ.  3)  KEL  = 4 
I F (I ELT.EQ.  9)  RETURN 
I F (I ELT.EQ. 10)  RETURN 
IF  (IELT.EQ.il)  RETURN 
C 

C TITLE  PAGE  WITH  ELEMENT  TYPE 
C 

WRITE  (6,2000) 

2000  FORMAT  (42H1T  IME  HISTORY  RESPONSE, /IX) 

WRITE  (6,2010)  (HD  (I  ELT, K)  , K= 1 , 4)  , M 
2010  FORMAT  ( 1 5H  ELEMENT  TYPE  (.4A6.24H)  / / / OUTPUT  SET  =,14/  IX) 

WRITE  (6,2020) 

2020  FORMAT  (14X,37H*ELEMENT  NUMBER*  - ^STRESS  COMPONENT*,  IX) 

C 

C SELECT  THE  LABEL  INDEX  FOR  THIS  ELEMENT  TYPE 
C 

N 1 = LAB  (KEL) 

C 

C SELECT  ELEMENT  COMPONENT  HEADINGS 

C 

DO  10  N=1 , L 

J ■=  (KD  (2 , N)  - 1 ) / N 1 + 1 
HH  (N , 2)  = SZ  (KEL , J) 

J = KD  (2 , N)  - (J-1)*  N 1 
HH  (N,  1)  = SY  (KEL, J) 

10  CONTINUE 
C 

C WRITE  THE  HEADING  LINE 

C 

WRITE  (6,2030)  (KD  (1 , I)  , HH  (1,1)  , HH  (1,2)  ,I  = 1,L) 

2030  FORMAT  (8X, 4HT I ME , 2X , 8(15, 1H-.2A3) , / IX) 

C 

RETURN 

END 
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SUBROUTINE  ELOUTR  (NEL , I S , L , I ELT, NS) 

C 

C CALLED  BY?  STRESR 
C 

C NEL 

C IS 

C L 

C 

C I ELT 

C NS 

C 
C 

DIMENSION  ISO) 

DIMENSION  SY  (12,6) ,SZ  (12,7) .LAB (12) , HD  (12,4) , HH  (12,2) 

C 

C ELEMENT  COMPONENT  LABELS 

C 

DATA  SY  ( 1,1)  /3H  / 

DATA  SY  ( 2,1)  /3HP1(/,  SY  ( 2,2)  /3HV2(/,  SY  ( 2,3)  /3HV3(/, 

1 SY  ( 2, A)  / 3HT 1 (/,  SY  ( 2,5)  /3HM2  (/,  SY  ( 2,6)  /3HM3  (/ 

DATA  SY  ( 3.1)  / 3HPX  (/ , SY  ( 3,2)  /3HVY(/,  SY  ( 3.3)  /3HVZ(/, 

1 SY  ( 3,4)  / 3HTX  (/ , SY  ( 3,5)  /3HMY  (/,  SY  ( 3,6)  /3HMZ  (/ 

DATA  SY  ( i+ , 1 ) /3HV  -/,  SY  ( 4,2)  /3HU  -/.  SY  ( A, 3)  /3HT  -/, 

1 SY  ( A, 4)  /3HUV-/ 

DATA  SY  ( 5,1)  /3HXX-/,  SY  ( 5,2)  /3HYY-/,  SY  ( 5,3)  /3HZZ-/ , 

1 SY  ( 5, A)  /3HXY-/,  SY  ( 5,5)  /3HYZ-/,  SY  ( 5,6)  /3HZX-/ 

DATA  SY  ( 6,1)  /3HXX-/,  SY  ( 6,2)  /3HYY-/,  SY  ( 6,3)  /3HXY-/ 

DATA  SY  ( 7,1)  /3HBDR/ 

DATA  SY  ( 8,1)  /3HSXX/,  SY  ( 8,2)  /3HSYY/ , SY  ( 8,3)  /3HSZZ/. 

1 SY  ( 8, A)  /3HSXY/,  SY  { 8,5)  /3HSYZ/,  SY  ( 8,6)  /3HSZX/ 

DATA  SY  (1  2 , 1 ) /3HPX(/,  SY(12,2)  / 3HVY  (/ , SY  (12,3)  /3HVZ(/, 

1 SY  (1  2 , A)  / 3HTX  (/ , SY  (12,5)  /3HMY  (/,  SY(12,6)  /3HMZ  (/ 

C 

DATA  SZ(  1,1)  /3HP/A/,  SZ  ( 1,2)  /3HP  / 

DATA  SZ(  2,1)  /3HI)  /,  SZ  ( 2,2)  /3HJ)  / 

DATA  SZ(  3,1)  /3HI)  /,  SZ(  3,2)  /3HJ)  / 

DATA  SZ(  A , 1)  /3HSO  /,  SZ  ( A, 2)  /3HS1  /.  SZ  ( A, 3)  /3HS2  /, 

1 SZ  ( A, A)  /3HS3  /,  SZ  ( A, 5)  /3HS4  / 

DATA  SZ(  5,1)  /3HSL1/,  SZ  ( 5,2)  /3HSL2/ 

DATA  SZ(  6,1)  /3HS/R/,  SZ  ( 6,2)  /3HM/R/ 

DATA  SZ(  7,1)  /3HY-F/,  SZ  ( 7,2)  /3HY-M/ 

DATA  SZ  ( 8,1)  /3H(0)/,  SZ(  8,2)  /3H  (1) /,  SZ  ( 8,3)  /3H(2)/, 

1 SZ  ( 8, A)  /3H  (3) /,  SZ(  8,5)  /3H(A)/,  SZ(  8,6)  /3H(5)/, 

2 SZ(  8,7)  /3H  (6)  / 

DATA  SZ  (1 2 , 1 ) /3HI)  /,  SZ(12,2)  /3HC)  /,  SZ  (12,3)  /3HJ)  / 

C 

DATA  LAB  /I ,6, 6 , A ,6, 3. 1 . 6,0,0, 0,6/ 

C 

C ELEMENT  TYPE  LABELS 
C 

DATA  HD  ( 1.D/6HT  R U /,HD(  1,2)/6HS  S /,HD(  1,3)/6H  / 

DATA  HD  ( 2,1)/6HB  E A /,HD(  2,2) /6HM  /,HD(  2,3)/6H  / 

DATA  HD  ( 3.D/6H2/D  /,HD(  3,2)  /6HP  L A /,HD(  3,3)/6HN  A R / 

DATA  HD  ( 4,1)/6HA  X I / , HD  ( 4,2)/6HS  Y M /,HD(  At3)/6HM  E T / 

DATA  HD  ( 5.D/6H3/D  /,HD(  5,2)/6HB  R I /,HD(  5,3)/6HC  K / 


= ELEMENT  NUMBER 

= ELEMENT  COMPONENT  NUMBERS 

= NUMBER  OF  ELEMENT  COMPONENT  NUMBERS  PER  LINE  OF 

OUTPUT  (12  MAXIMUM) 

= ELEMENT  TYPE  (1 ,2, ....  12) 

= MAXIMUM  NUMBER  OF  STRESS  COMPONENTS  ASSOCIATED 
WITH  THE  IELT-TH  ELEMENT  TYPE 
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DATA  HD  ( 6.D/6HP  L A /,HD(  6,2)/6HT  E / /,HD(  6,3)/6HS  H E / 

DATA  HD  ( 7,1) /6HB  0 U /.HD  ( 7,2) /6HN  D A /,HD(  7,3) /6HR  Y / 

DATA  HD  ( 8.D/6HT  H I /.HD  C 8,2)  /6HC  K /,HD(  8,3)/6HS  H E / 

DATA  HD(12, 0/6H3/D  / , HD  (12,2)  /6HP  I P /,HD  (12, 3)  /6HE  / 

C 

DATA  HD  ( 1,4)/6H  / 

DATA  HD  ( 2,4) /6H  / 

DATA  HD  ( 3,4) /6H  / 

DATA  HD  ( 4,4) /6HR  I C / 

DATA  HD  ( 5.4) /6H  / 

DATA  HD  ( 6,4) /6HL  L / 

DATA  HD  ( 7,4) /6H  / 

DATA  HD ( 8,4) /6HL  L / 

DATA  HD  (12,4) /6H  / 

C 

C DETERMINE  ADJUSTED  ELEMENT  TYPE  FOR  TABLE  SELECTION 
C 

IF(L.LT.l)  RETURN 
KEL  = I ELT 

IF  (IELT.EQ.12  .AND.  NS.EQ.12)  KEL  * 3 
I F (I ELT.EQ.3)  KEL  - 4 
I F (I ELT.EQ.  9)  RETURN 
I F (I ELT.EQ. 10)  RETURN 
I F (I ELT.EQ. 1 1)  RETURN 
C 

C TITLE  PAGE  WITH  ELEMENT  TYPE 

C 

WRITE  (6,2010)  (HD (IELT.K) ,K-1,4) , NEL 
2010  FORMAT  ( 1 5H0ELEMENT  TYPE  (,4A6,28H)  / / / ELEMENT  NUMBER  (, 

1 14,  1H) , / IX) 

C 

C SELECT  ELEMENT  COMPONENT  HEADINGS 

C 

N 1 * LAB  (KEL) 

DO  10  N-l ,L 

J = (IS  (N)  -1)/  N1  + 1 

HH  (N , 2)  = SZ  (KEL,  J) 

J = IS  (N)  - (J-l)  * N 1 

HH  (N,  1)  = SY  (KEL , J) 

10  CONTINUE 
C 

C WRITE  THE  HEADING  LINE 

C 

WRITE  (6,2030)  (HH  (I  , 1)  ,HH  (I  ,2)  , l-l.L) 

2030  FORMAT  (12(5X,2A3)  ) 

C 

RETURN 

END 

SUBROUTINE  ELOUTS  (KD , L , I ELT, M,NS) 

C 

C CALLED  BY?  SDSPLY 

C 

C KD(1,I)  - ELEMENT  NUMBERS  IN  THIS  OUTPUT  SET 

C (I  RANGES  FROM  1 TO  L) 

C KD  (2 , I ) =■  ELEMENT  COMPONENT  NUMBERS 
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C 

C 

C 

C 

C 

C 

c 


c 

c 

c 


c 


c 

c 

c 

c 


L 

I ELT 

M 

NS 


NUMBER  OF  ELEMENT  COMPONENT  NUMBERS  PER  LINE  OF 
OUTPUT  (8  MAXIMUM) 

ELEMENT  TYPE  (1,2 12) 

OUTPUT  SET  NUMBER 

MAXIMUM  NUMBER  OF  STRESS  COMPONENTS  ASSOCIATED 
WITH  THE  IELT-TH  ELEMENT  TYPE 


DIMENSION  KD (2 , 1 ) 

DIMENSION  SY  (1  2 , 6)  , SZ  ( 1 2 , 7)  . LAB  ( 1 2)  , HD  (1 2 , 4)  ,HH  (8, 2) 
ELEMENT  COMPONENT  LABELS 


DATA 

SY  ( 1,1) 

/3H  / 

/3HV3  (/, 

DATA 

SY  ( 2,1) 

/3HP1  (/, 

SY  ( 

2,2) 

/3HV2  (/, 

SY  ( 2,3) 

1 

SY  ( 2,4) 

/3HT1  (/, 

SY  ( 

2,5) 

/3HM2 (/, 

SY  ( 2,6) 

/3HM3  (/ 

DATA 

SY  ( 3,1) 

/3HPX (/, 

SY  ( 

3.2) 

/3HVY (/, 

SY  ( 3.3) 

/3HVZ  (/, 

1 

SY  ( 3.4) 

/ 3HTX  (/, 

SY( 

3,5) 

/3HMY (/, 

SY  ( 3,6) 

/3HMZ  (/ 

DATA 

SY  ( 4,  1) 

/3HV  -/, 

SY  ( 

4,2) 

/3HU  -/, 

SY  ( 4,3) 

/3HT  -/. 

1 

SY  ( 4,4) 

/3HUV-/ 

DATA 

SY  ( 5.1) 

/3HXX-/, 

SY  ( 

5,2) 

/3HYY-/ , 

SY  ( 5,3) 

/3HZZ-/, 

1 

SY  ( 5.4) 

/3HXY-/ , 

SY  ( 5,5) 

/3HYZ-/, 

SY  ( 5,6) 

/3HZX-/ 

DATA 

SY  ( 6,1) 

/3HXX-/, 

SY  ( 

6,2) 

/3HYY-/. 

SY  ( 6,3) 

/3HXY-/ 

DATA 

SY  ( 7.0 

/3HBDR/ 

SY ( 8,3) 

DATA 

SY  ( 8,1) 

/3HSXX/, 

SY  ( 

8,2) 

/3HSYY/ , 

/3HSZZ/, 

1 

SY  ( 8,4) 

/3HSXY/, 

SY  ( 

8,5) 

/3HSYZ/, 

SY  ( 8,6) 

/3HSZX/ 

DATA 

SY  (12,1) 

/3HPX (/, 

SY  (12,2) 

/3HVY (/, 

SY  (12,3) 

/3HVZ (/, 

1 

SY  (12,4) 

/3HTX  (/, 

SY  (12,5) 

/3HMY (/, 

SY  (12,6) 

/3HMZ  (/ 

DATA 

SZ(  1,1) 

/3HP/A/, 

SZ( 

1,2) 

/3HP  / 

DATA 

SZ(  2,1) 

/3HD  /, 

SZ  ( 

2,2) 

/3HJ)  / 

DATA 

SZ(  3,1) 

/3HI)  /, 

SZ  ( 

3,2) 

/3HJ)  / 

DATA 

SZ(  4,1) 

/3HS0  /, 

SZ  ( 

4,2) 

/3HS1  /, 

SZ(  4,3) 

/3HS2  /, 

1 

SZ(  4,4) 

/3HS3  /. 

sz( 

4,5) 

/3HS4  / 

DATA 

SZ(  5.  1) 

/3HSL 1 / , 

SZ( 

5,2) 

/3HSL2/ 

DATA 

SZ(  6,  1) 

/3HS/R/, 

sz( 

6,2) 

/3HM/R/ 

DATA 

SZ  ( 7,1) 

/3HY-F/, 

sz  ( 

7,2) 

/3HY-M/ 

DATA 

SZ(  8,1) 

/3H  (0)/, 

SZ(  8r2) 

/3H  (1)/, 

SZ(  8,3) 

/3H (2) / , 

1 

SZ(  8,4) 

/3H  (3)  / , 

sz( 

8,5) 

/3H  (4)  / , 

SZ(  8,6) 

/3H  (5)/, 

2 

SZ  ( 8,7) 

/3H  (6)/ 

/3HJ)  / 

DATA 

SZ  (12, 1) 

/3HI)  /, 

SZ  (1  2 , 2) 

/3HC)  /, 

SZ (12,3) 

DATA  LAB  /I ,6,6, 4, 6,3. 1 .6, 0,0, 0,6/ 


ELEMENT  TYPE  LABELS 

DATA  HD  ( 1,1) /6HT  R U /,HD(  1,2)/6HS  S /,HD(  1,3)/6H  / 

DATA  HD  ( 2.D/6HB  E A /,HD(  2,2)/6HM  /,H0(  2,3)/6H  / 

DATA  HD  ( 3.D/6H2/D  / , HD  ( 3,2)  /6HP  L A /,HD(  3.3) /6HN  A R / 

DATA  HD  ( 4,1)/6HA  X I /,HD(  4,2)  /6HS  Y M /,HD(  4,3) /6HM  E T / 

DATA  HD  ( 5,1)/6H3/D  /,HD(  5.2)  /6HB  R I /,HD(  5.3)/6HC  K / 

DATA  HD  ( 6,1)/6HP  L A /,HD(  6,2) /6HT  E / /,HD(  6,3)/6HS  HE/ 

DATA  HD  ( 7.D/6HB  0 U /,HD(  7.2)  /6HN  D A /,HD(  7.3)  /6HR  Y / 

DATA  HD  ( 8,1)/6HT  H I /,HD(  8,2) /6HC  K /,HD(  8,3) /6HS  HE/ 
DATA  HD  (12,  D/6H3/D  /,HD  (12,2)  /6HP  I P /, HD  (1 2 , 3)  /6HE  / 


C 
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DATA  HD  ( 1,4) /6H  / 

DATA  HD  ( 2, 4) /6H  / 

DATA  HD  ( 3,4) /6H  / 

DATA  HD  ( 4,4) /6HR  I C / 

DATA  HD  ( 5,4) /6H  / 

DATA  HD  ( 6,4) /6HL  L / 

DATA  HD  ( 7.4) /6H  / 

DATA  HD  ( 8,4) /6HL  L / 

DATA  HD  (12,4) /6H  / 

C 

C DETERMINE  ADJUSTED  ELEMENT  TYPE  FOR  TABLE  SELECTION 
C 

IF(L.LT.l)  RETURN 
KEL  = I ELT 

I F (I ELT.EQ. 12  .AND.  NS.EQ.12)  KEL  - 3 
I F (I  ELT.EQ. 3)  KEL  = 4 
I F (I ELT.EQ.  9)  RETURN 
I F (I ELT.EQ. 10)  RETURN 
I F (I ELT.EQ. 11)  RETURN 
C 

C TITLE  PAGE  WITH  ELEMENT  TYPE 
C 

WRITE  (6,2000) 

2000  FORMAT  (42H1T  IME  HISTORY  RESPONSE,/  IX) 

WRITE  (6,2010)  (HD  (I ELT,K)  ,K=1 ,4) , M 
2010  FORMAT  ( 1 5H  ELEMENT  TYPE  (.4A6.24H)  / / / OUTPUT  SET  =.14/  IX) 

WRITE  (6,2020) 

2020  FORMAT  (13X.40H  ^ELEMENT  NUMBER*  - (*STRESS  COMPONENT*),  IX) 

C 

C SELECT  THE  LABEL  INDEX  FOR  THIS  ELEMENT  TYPE 
C 

N 1 = LAB  (KEL) 

C 

C SELECT  ELEMENT  COMPONENT  HEADINGS 
C 

DO  10  N=1 , L 

J = (KD (2,N) -1) / N 1 + 1 
HH  (N , 2)  = SZ  (KEL , J) 

J = KD  (2 . N)  - (J- 1 ) * N 1 
HH  (N, 1)  = SY  (KEL, J) 

10  CONTINUE 
C 

C WRITE  THE  HEADING  LINE 

C 

WRITE  (6,2030)  (KD(1,I),HH(I,1),HH(I,2),I-1,L) 

2030  FORMAT  (8X,  4HTIME.2X,  8 (15, 1H-.2A3)  ) 

C 

RETURN 

END 

SUBROUTINE  EMID  ( I D , MASS , NUMNP, NEQB) 

C 

C CALLED  BY?  H I STRY 

C 

DIMENSION  ID (NUMNP, 6) .MASS  (NEQB) 

C 
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REWIND  3 
REWIND  8 
READ  (8)  ID 
L-l 

DO  200  N=1 ,NUMNP 
DO  100  1-1,6 
50  MASS (L) =0 

IF  (ID(N,I)  . LE  .0)  GO  TO  100 
I F (L.LE.NEQB)  GO  TO  75 
WRITE  (3)  MASS 
L-l 

75  IF  (I . GT.3)  GO  TO  90 
MASS  (L)  -I 
90  L-L+l 
100  CONTINUE 
200  CONTINUE 

DO  300  l-L.NEQB 
300  MASS  ( I ) =0 

WRITE  (3)  MASS 
C 

RETURN 

END 

SUBROUTINE  EMI  DR  (I D.MASS.NUMNP.NEQB) 

C 

C CALLED  BY?  RESPEC 
C 

DIMENSION  ID  (NUMNP.6) .MASS (NEQB) 

C 

REWIND  3 
REWIND  8 
READ  (8)  ID 
L=1 

DO  200  N-l.NUMNP 
DO  100  1=1,6 
50  MASS  (L) =0 

I F (ID  (N, I)  . LE .0)  GO  TO  100 
IF  (L.LE.NEQB)  GO  TO  75 
WRITE  (3)  MASS 
L=1 

75  IF  (I .GT.3)  GO  TO  90 
MASS  (L)  -I 
90  L-L+l 
100  CONTINUE 
200  CONTINUE 

DO  300  l-L.NEQB 
300  MASS ( I ) *0 

WRITE  (3)  MASS 
C 

RETURN 

END 

SUBROUTINE  EMI DS (I D.MASS.NUMNP.NEQ) 

C 

C CALLED  BY?  STEP 
C 

C THIS  ROUTINE  CREATES  AN  INTEGER  ARRAY  *MASS*  WHICH  FLAGS  THE 
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C TRANSLATIONAL  COMPONENT  NUMBERS  ( 1=X , 2=Y , 3=Z)  ASSOCIATED  WITH 

C EACH  SYSTEM  DEGREE  OF  FREEDOM.  *MASS*  IS  SAVED  ON  TAPE7  FOR 

C LATER  USE  IN  SUBROUTINE  *GROUND*.  *MASS*  ELEMENTS  EQ.O  INDICATE 
C ROTATIONAL  COMPONENT  FOR  THAT  DEGREE  OF  FREEDOM. 

C 

DIMENSION  I D (NUMNP.6)  .MASS (NEQ) 

C 

NT-7 

REWIND  NT 
C 

L-l 

DO  200  N-l.NUMNP 
DO  100  1*1,6 
50  MASS  (L) =0 

I F (ID  (N,  I)  . LE  .0)  GO  TO  100 
I F (I .GT.3)  GO  TO  90 
MASS  (L) - 1 
90  L-L+1 
100  CONTINUE 
200  CONTINUE 
C 

WRITE  (NT)  MASS 

RETURN 

END 

SUBROUTINE  FACEPR  (NEL , KD I S , KXYZ , XX, N0D9.H , P, PL , NF ACE , LT , PWA , KLS) 
C 

C CALLED  BY  ? THDFE 

C CALLS  ? FNCT 

C 

c 

c 

C THIS  ROUTINE  COMPUTES  NODE  FORCES  DUE  TO  APPLIED  ELEMENT  FACE 
C PRESSURE  DISTRIBUTIONS 

C 
C 

DIMENSION  XX  (3,1)  ,N0D9(1)  ,H  (1)  ,P(3.  0 ,PL  (1)  ,PWA  (1) 

DIMENSION  XJ  (3,3)  .ETA  (3)  , KFACE  (6,8)  , KCRD  (6)  , FVAL  (6)  , I PRM  (3)  , 

1 PR  (8)  , NODES  (8)  , I PR1*  (4) 

COMMON  /GAUSS/  XK  (4,4)  ,WGT  (4,4) 

C 


DATA 

KFACE 

/ l,  ; 

2,  1 

. 4, 

1.  5 

1 f 

1 

4, 

3. 

5.  8, 

2, 

6, 

2 

8, 

7. 

6,  7. 

3. 

7. 

3 

5. 

6, 

2,  3, 

4, 

8, 

- 4 

12, 

10, 

17. 

20, 

9, 

13. 

5 

20, 

19. 

13. 

15. 

10, 

14, 

6 

16, 

14. 

18, 

19. 

11, 

15. 

7 

17. 

18, 

9, 

11. 

12, 

16/ 

DATA 

KCRD 

/ l, 

, l 

. 2, 

2, 

3. 

, 3/ 

DATA 

FVAL 

/ 1. 

,-l . 

. 1.. 

-1., 

1., 

-1./ 

DATA 

1 PRM 

/ 2 

. 3 

. 1/ 

DATA 

1 PRlf 

/ 2, 

3. 

4, 

1/ 

C 

C 


DETERMINE  THE  ELEMENT  NODES  CONTRIBUTING  TO  FORCE  CALCULATIONS 
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C 

C 


C 

C 

C 


C 


c 


c 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 


c 

c 

c 


ON  THIS  FACE 
DO  2 1-1,4 

NODES  (I  ) = KF ACE  (NFACE  , I) 

NODES  (1+4)  = 0 
2 CONTINUE 

IF  (KDIS.LT.9)  GO  TO  9 

NN9  = KDIS-8 

DO  8 K=5,8 
DO  k 1-1, NN9 

J = I 

IF  (KFACE  (NFACE, K)  .EQ.NOD90))  GO  TO  6 

4 CONTINUE 
GO  TO  8 

6 NODES  (K)  = J 

8 CONTINUE 

9 CONTINUE 

SET  UP  THE  PRESSURE  VECTOR  FOR  THE  FOUR  FACE  CORNER  NODES 

1.  ADJUST  THE  SIGN  OF  THE  PRESSURES  SO  THAT  POSITIVE 
PRESSURE  ALWAYS  COMPRESSES  THE  ELEMENT 

FACT  = -FVAL  (NFACE) 

GO  TO  (10,30) , LT 

2.  DISTRIBUTED  PRESSURE  GIVEN  AT  THE  CORNER  NODES 

10  DO  25  K-1,8 

I F (NODES  (K)  . EQ .0)  GO  TO  25 

IF (K.GT.4)  GO  TO  15 

PR  (K)  - PWA(K)  * FACT 
GO  TO  25 

15  J - K-4 
L - I PR4  (J) 

PR  (K)  - (PWA(J)  + PWA  (L) ) * 0.5  * FACT 

25  CONTINUE 
GO  TO  75 

3.  ELEMENT  FACE  EXPOSED  TO  HYDROSTATIC  PRESSURE 


30  GAMMA  = PWA(l)*  FACT 
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C 


XLN  - 0.0 
DO  35  K-1.3 

ETA  (K)  - PWA(K+4)  - PWA  (K+ 1 ) 

35  XLN  = XLN  + ETA  (K) **2 
XLN  -SQRT(XLN) 

C 

I F (XLN .GT. 1 .OE-6)  GO  TO  40 
C 

WRITE  (6,3000)  KLS.NEL 

3000  FORMAT  (3 1 HOERROR***  PRESSURE  LOAD  SET  (, 1 3. 1 5H)  FOR  ELEMENT  (, 
1 I5.43H)  HAS  UNDEFINED  HYDROSTATIC  SURFACE  NORMAL.,  / IX) 

STOP 


C 


C 

C 

C 


40  DO  45  K=1 ,3 

45  ETA  (K)  - ETA  (K)/  XLN 

DO  70  N-l ,8 

IF  (NODES  (N)  .EQ.O)  GO  TO  70 


C 


C 

C 

C 


C 

c 

c 


c 

c 

c 

c 

c 

c 


XLN  * 0.0 

NOD  * NODES  (N) 

I F (N.GT.4)  NOD  - NOD  + 8 

DO  50  1-1,3 

50  XLN  = XLN  + (XX  ( I , NOD)  - PWA ( I + 1 ) ) * ETA  (I ) 

PR  (N)  = XLN*  GAMMA 

IF  (XLN. LT. 0.0)  PR (N)  = 0.0 

70  CONTINUE 
75  CONTINUE 

SET  UP  VARIABLES  FOR  THE  SURFACE  INTEGRATION 

ML  = KCRD(NFACE) 

MM  - IPRM(ML) 

MN  * IPRM(MM) 

SURFACE  INTEGRATION  LOOP 

ETA  (ML)  - FVAL(NFACE) 

DO  300  LX- 1,3 

ETA  (MM)  - XK  (LX, 3) 


C 


C 


C 


DO  300  LY-1,3 
ETA  (MN)  - XK(LY,3) 

WT  - WGT  (LX , 3)  * WGT(LY,3) 
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C EVALUATE  THE  INTERPOLATION  FUNCTIONS  AND  JACOBIAN  MATRIX 
C 

CALL  FNCT  (ETA  (1)  , ETA  (2) , ETA  (3)  . H , P , N0D9, XJ , DET, XX , KD I S , KXYZ , NEL) 
C 

C COMPUTE  THE  DIRECTION  COSINES  OF  THE  UNIT  SURFACE  NORMAL  VECTOR 
C AT  THIS  SAMPLE  POINT 
C 

A 1 = XJ  (MM, 2)  * XJ(MN,3)-  XJ(MM,3)*  XJ(MN,2) 

A2  = XJ  (MM,  3)  * XJ  (MN , 1 ) - XJ(MM,1)*  XJ(MN,3) 

A3  = XJ  (MM,  1)  * XJ  (MN , 2)  - XJ(MM,2)*  XJ  (MN , 1) 

C 

AA  =SQRT(A1**2  + A2**2  + A3**2) 

I F (AA.GT. 1 .OE-8)  GO  TO  100 
C 

WRITE  (6,3010)  NFACE.NEL 

3010  FORMAT  (38H0ERR0R***  UNDEFINED  NORMAL  IN  FACE  (,I1,5H)  FOR, 

1 10H  ELEMENT  (, 1 5 . 2H) / IX) 

STOP 


C 

100  FACT  = 1 .O/AA 
A 1 = Al*  FACT 
A2  = A2*  FACT 
A3  = A3*  FACT 
C 

C COMPUTE  THE  FIRST  FUNDAMENTAL  FORM  (AREA  DIFFERENTIAL) 
C 

AA  = 0.0 
BB  = 0.0 
CC  = 0.0 
DO  120  1=1,3 
AA  = AA  + XJ(MM,I)**2 
CC  = CC  + XJ  (MN,  l)**2 
120  BB  = BB  + XJ  (MM, I ) * XJ(MN.I) 

C =SQRT(AA*CC  - BB**2) 

C 

C INTERPOLATE  FOR  THE  PRESSURE  AT  THIS  SAMPLE  POINT 

C 

PRESS  = 0.0 


C 

c 

c 

c 

c 


DO  130  K=1 , 8 

I F (NODES  (K)  . EQ.O)  GO  TO  130 

NOD  = NODES  (K) 
IF(K.GT.i*)  NOD  - NOD  + 8 

PRESS  » PRESS  + H (NOD)  * PR  (K) 
130  CONTINUE 

FACT  = WT*  C*  PRESS 


C 

C 

C 


C 


ASSEMBLE  THE  NODE  FORCE  CONTRIBUTION 
DO  160  L-l ,8 


o o o 
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IF  (NODES  (L)  . EQ .0)  GO  TO  160 
C 

IF  (L. GT.lt)  GO  TO  1 40 
C 

C 1 . CORNER  NODES 

C 

N = NODES  (L) 

K = 3*N 
GO  TO  150 
C 

C 2.  SIDE  NODES 

C 

140  J = NODES  (L) 

N = J+8 
K = 3*  N0D9(J) 

C 

150  QQ  = FACT*  H (N) 

C 

PL  (K-2)  = PL  (K-2)  + QQ*  A1 

PL  (K-1)  = PL  (K- 1 ) + QQ*  A2 

PL  (K  ) = PL  (K  ) + QQ*  A3 

160  CONTINUE 
C 

300  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  FNCT  (R , S ,T, H , P , N0D9, XJ , DET, XX, I ELD , I ELX, NEL) 
C 

C CALLED  BY  ? FACEPR 
C 
C 
C 

C 

c . 

C.  PROGRAM 
C . 

C . TO  FIND  INTERPOLATION  FUNCTIONS  ( H ) 

C . AND  DERIVATIVES  ( P ) CORRESPONDING  TO  THE  NODAL 

C . POINTS  OF  A CURVILINEAR  ISOPARAMETRIC  HEXAHEDRON 

C . OR  SUBPARAMETRIC  HEXAHEDRON  (8  TO  21  NODES) 

C . 

C . TO  FIND  JACOBIAN  ( XJ  ) AND  ITS  DETERMINANT  ( DET  ) 


C 

DIMENSION  H (1)  ,P(3,1)  ,N0D9(O  , I PERM  (8)  . X J (3.3)  ,XX(3,1) 
C 

DATA  IPERM  / 2 , 3, 4 , 1 , 6 , 7 , 8, 5 / 

C 

I EL  * I ELD 
NND9=  I ELD-8 
C 

RP-1 .0  + R 
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SP=1.0  + S 
TP-1 .0  + T 
RM-1.0  - R 
SM-1.0  - S 
TM-1.0  - T 
RR-1.0  - R*R 
SS-1 .0  - S*S 
TT-1 .0  - T*T 
C 
C 

C INTERPOLATION  FUNCTIONS  AND  THEIR  DERIVATIVES 

C 

c 

C 8-NODE  BRICK 

C 

H(1)=0.125*RP*SP*TP 
H (2)  =0.125*RM*SP*TP 
H (3)-0. 125*RM*SM*TP 
H (it)  =0. 125*RP*SM*TP 
H (5)=0. 125*RP*SP*TM 
H (6) =0 . 1 25*RM*SP*TM 
H (7) =0 . 1 25*RM*SM*TM 
H (8) =0 . 1 25*RP*SM*TM 
C 

P(1,1)=0.125*SP*TP 
P(l,2)— P(l.l) 

P(1  ,3)=-0.125*SM*TP 

P (1 ,4)— P (1,3) 

P (1 ,5) =0 . 1 25*SP*TM 
P (1 ,6)  — P (1,5) 

P(1,7)—0.125*SM*TM 
P (1 ,8)  — P (1 ,7) 

C 

P (2, 1) =0. 125*RP*TP 
P(2,2)=0.125*RM*TP 
P (2,3)  — P (2.2) 

P (2,4)  — P (2,  1) 

P (2,5)  =0.125*RP*TM 
P (2 , 6) =0 . 1 25*RM*TM 
P (2,7)  — P (2,6) 

P (2,8)  — P (2,5) 

c 

P(3,1)-0.125*RP*SP 
P (3.2)  -0. 125*RM*SP 
P (3,3)  -0.125*RM*SM 
P(3,it)-0.125*RP*SM 

P (3.5)  — P (3.D 

P (3.6)  — P (3.2) 

P (3.7)  — P (3.3) 

P (3.8)  — P (3.1*) 

C 

IF  (IEL.EQ.8)  GO  TO  50 
C 
C 

C ADD  DEGREES  OF  FREEDOM  IN  EXCESS  OF  8 
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C 

1=0 

2 1=1  + 1 

I F (I .GT.NND9)  GO  TO  40 
NN=N0D9(I)  - 8 

GOTO  (9. 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20,21)  , NN 
C 

9  H (9)  = 0.25*RR*SP*TP 
P (1 ,9)  = -0.50*R*SP*TP 
P (2,9)  - 0.25*RR*TP 
P (3.9)  = 0.25*RR*SP 
GO  TO  2 

10  H (10)=0.25*RM*SS*TP 
P (1 , 10)  =-0.25*SS*TP 

P (2, 10)  =-0 . 50*RM*S*TP 
P (3, 10) = 0.25*RM*SS 
GO  TO  2 

11  H (1 1)  =0.25*RR*SM*TP 

P (1 , 1 1)=-0.50*R*SM*TP 
P ( 2,1 1) =-0.25*RR*TP 
P (3, 1 1)=  0.25*RR*SM 
GO  TO  2 

12  H (12) =0.25*RP*SS*TP 
P (1  , 12)=  0.25*SS*TP 

P (2,  12)=-0.50*RP*S*TP 
P (3.12)  = 0.25*RP*SS 
GO  TO  2 

13  H (13) =0.25*RR*$P*TM 

P (1 , 13)  —0.50*R*SP*TM 
P (2, 13)  = 0.25*RR*TM 
P (3.13)  =-0.25*RR*SP 
GO  TO  2 

H H ( 1 4) =0 . 25*RM*SS*TM 
P (1 , 14) =-0.25*SS*TM 
P (2, 14)=-0.50*RM*S*TM 
P (3. 14)=-0.25*RM*SS 
GO  TO  2 

15  H (15) =0.25*RR*SM*TM 

P (1 , 15) =-0.50*R*SM*TM 
P (2 , 1 5) =-0.25*RR*TM 
P (3.15) =-0.25*RR*SM 
GO  TO  2 

16  H (16) =0.25*RP*SS*TM 
P (1 , 16) = 0.25*SS*TM 

P (2, 16)=-0.50*RP*S*TM 
P (3. 16)=-0.25*RP*SS 
GO  TO  2 

17  H ( 1 7) =0 . 25*RP*SP*TT 
P (1 , 1 7) =0. 25*SP*TT 
P (2 , 1 7) “0 . 25*RP*TT 

P (3 . 17)— 0.50*RP*SP*T 
GO  TO  2 

18  H ( 1 8) *0 . 25*RM*SP*TT 
P (1 , 1 8) =-0.25*SP*TT 
P (2, 18) = 0.25*RM*TT 
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P (3,  18)—  0.50*RM*SP*T 
GO  TO  2 

19  H (19)  =0.25*RM*SM*TT 
P (1 , 19)— 0.25*SM*TT 
P (2 , 19)— 0.25*RM*TT 

P (3, 19)  — 0.50*RM*SM*T 
GO  TO  2 

20  H (20) =0 . 25*RP*SM*TT 
P ( 1 , 20) = 0.25*SM*TT 
P(2,20)—0.25*RP*TT 
P(3,20)— 0-50*RP*SM*T 
GO  TO  2 

21  H (21)=RR*SS*TT 

P (1 ,21)— 2.0*R*SS*TT 
P (2,21) — 2.0*S*RR*TT 
P (3,21) — 2.0*T*RR*SS 
GO  TO  2 
C 

C MODIFT  FIRST  8 FUNCTIONS  IF  9 OR  MORE  NODES  IN  ELEMENT 
C 

40  I H=0 

41  I H= I H + 1 

IF  (IH.GT.NND9)  GO  TO  50 
I I = I H + 7 

IF  (II .EQ. I ELX)  GO  TO  51 

42  IN=N0D9(IH) 

IF  (IN.GT.l6)  GO  TO  46 
I 1 = I N -8 
I 2*1  PERM (II) 

H (I  1)  =H  (I  1)  - 0.5*H(IN) 

H ( I 2) =H  ( I 2)  - 0.5*H  (IN) 

H (I H+8) -H  (IN) 

DO  45  J-1,3 

P (J , I 1 ) =P  (J  , I 1 ) - 0 . 5*P  (J , I N) 

P (J,  12)  =P  (J,  I 2)  - 0.5*P  (J,  IN) 

45  P (J,  I H+8)  =P  (J,  IN) 

GO  TO  41 

46  IF  (IN.EQ.21)  GO  TO  30 
I 1 = I N -16 

12=11+4 

H (I  1)=H  (I  1)  - 0.5*H  (IN) 

H ( I 2)  =H  ( I 2)  - 0.5*H(IN) 

H ( I H+8)  =H  (IN) 

DO  47  J-1,3 

P (J , I 1)  =P  (J  , I 1)  - 0.5*P(J,  IN) 

P(J,  I2)=P(J,  12)  - 0.5*P(J.IN) 

47  P (J,  IH+8J-P  (J,  IN) 

GO  TO  41 

C 

C MODIFY  FIRST  20  FUNCTIONS  IF  NODE  21  IS  PRESENT 
C 

30  I H=0 

31  I H=l H + 1 

I N=N0D9  ( I H) 

IF  (IN.EQ.21)  GO  TO  35 
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IF  (IN.GT.16)  GO  TO  33 
I 1 = IN  -8 
I 2= I PERM  ( I 1) 

H (I  1)-H  (11)  + 0. 125*H  (21) 

H ( I 2)  =H  ( I 2)  + 0.125*H(21) 

DO  32  J-1,3 

P(J,  I 1)=P(J,  I 1)  + 0. 125*P  (J , 2 1 ) 

32  P (J  , I 2)  =P  (J , I 2)  + 0.125*P(J,21) 

GO  TO  31 

33  I 1 = I N - 16 
12=11  + 1+ 

H (I  1)-H  (I  1)  + 0. 125*H  (21) 

H ( I 2)  =H  ( I 2)  + 0.125*H(21) 

DO  5k  J=1 ,3 

P (J  , I 1)=P  (J,  I 1)  + 0. 125*P  (J  , 2 1 ) 

5k  P (J  , I 2)  =P  (J , I 2)  + 0.125*P(J,21) 

GO  TO  31 

35  DO  36  1-1.8 

H ( I ) =H  ( I ) - 0.125*H(21) 

DO  36  J=1 ,3 

36  P (J  , l)=P(J,  I)  - 0.125*P(J>21) 

NN=NND9  + 7 

IF  (NN.EQ.8)  GO  TO  50 
DO  38  1=9. NN 
H (l)=H  (I)  - 0.25*H  (21) 

DO  38  J-1,3 

38  P (J,  l)=P  (J,  I)  - 0.25*P  (J , 2 1 ) 

H (NND9+8)  =H  (21) 

DO  39  J =1.3 

39  P (J  , NND9+8)  =P  (J , 2 1 ) 

C 

C 

C EVALUATE  JACOBIAN  MATRIX  AT  POINT  (R,S,T) 

C 

C 

50  IF  (I ELX.LT. I ELD)  RETURN 

51  DO  100  1=1,3 
DO  100  J-1,3 
DUM-0.0 

DO  90  K= 1 , I ELX 
90  DUM-DUM  + P (I  ,K)  *XX  (J,K) 

100  XJ  (I ,J) -DUM 
C 
C 

C COMPUTE  DETERMINANT  OF  JACOBIAN  MATRIX  AT  POINT  (R,S,T) 

C 

C 

DET  = XJ (1 , 1) *XJ  (2,2) *XJ  (3,3) 

1 + XJ  (1 ,2)  *XJ  (2,3)  *XJ  (3,1) 

2 + XJ  (1 ,3)  *XJ  (2, 1)  *XJ  (3.2) 

3 - XJ  (1  , 3)  *XJ  (2 , 2)  *XJ  (3,1) 

k - XJ  (1 .2)  *XJ  (2, 1)  *XJ  (3.3) 

5 - XJ  (1  , 1)  *XJ  (2,3)  *XJ  (3,2) 

I F (DET.GT. 1 . OE -8)  GO  TO  110 
WRITE  (6,2000)  NEL.R.'S.T 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


STOP 

110  IF  (IELX.LT.  IELD)  GO  TO  42 
C 
C 

RETURN 

C 

C 

C 

2000  FORMAT  (49H0ERR0R***  NEGATIVE  OR  ZERO  JACOBIAN  DETERMINANT, 

1 23H  COMPUTED  FOR  ELEMENT  (,I5JH),  / 

2 12X,  3HR  =.  F 10.5  / 

3 12X,  3HS  -,  F 10.5  / 

4 12X,  3HT  =,  F 10.5  / IX) 

C 

C 

END 

SUBROUTINE  FORMB(S.T.B) 

C 

C CALLED  BY?  QUAD 
C 

COMMON  /ELPAR/  NPAR  ( 1 4) , NUMNP ,MBAND , NELTYP , N 1 , N2 , N3. N4 , N5 . MTOT , NEQ 
COMMON  /EM/  LM(12)  ,U  (12, 12)  ,P  (12,1*)  ,XM(12)  , 

1 Tl  (20,1*)  , |X  (1*)  , IE  (5)  ,NS,D(4,4)  ,EMUL(1*,5)  .RR(M  ,ZZ(4)  ,H(6)  ,HS(6)  , 

2 HT  (6)  ,HR  (6)  ,HZ  (6)  , FAC,  XMM,  PRESS,  EE  (10)  ,TT  I (1*)  , PP  (1 2 , 4)  .THICK 

3 ,TMP  (1*)  , QP  (1 2)  , ALP  (4)  , IF  ILL2  (4236) 

DIMENSION  B (20, 1 2) 

DIMENSION  I I (6) , JJ  (6) 

DATA  I 1/1  ,2, 3,1*. 9, 10/,  JJ/5,6,7,8,  11,12/ 

C 

SM=1 . 0-S 
SP=1 . 0+S 
TM= 1 . 0-T 
TP=1 . 0+T 
C 

H ( 1 ) =SM*TM/4 . 

H (2)=SP*TM/4. 

H (3)  =SP*TP/4 . 

H (1*)  =SM*TP/4 . 

H (5)  = (1  .0-S*S) 

H (6)  - { 1 .0-T*T) 

C 

HS  (1)— TM/4. 

HS  (2)— HS  (1) 

HS  (3)  *TP/4 . 

HS  (4)  — HS  (3) 

HS  (5)— 2.*S 
HS  (6) -0.0 
C 

HT  (1) — SM/4. 

HT  (2)  — SP/4 . 

HT  (3)  — HT(2) 

HT  (4)  — HT  (1) 

HT  (5)  -0.0 
HT  (6)—  2.*T 
C 
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PZT-HT  (1)  *11  (1)  +HT  (2)  *ZZ  (2)  +HT  (3)  *ZZ  (3)  +HT  (4)  *ZZ  (4) 
PZS=HS  (1)  *ZZ  (1)  +HS  (2)  *ZZ  (2)  +HS  (3)  *ZZ  (3)+HS  (4)  *ZZ  (4) 
PRS=HS  (1)  *RR  (1)  +HS  (2)  *RR  (2)  +HS  (3)  *RR  (3)  +HS  (4)  *RR  (4) 
PRT=HT  ( 1 ) *RR  ( 1 ) +HT  (2)  *RR  (2)  +HT  (3)  *RR  (3)  +HT  (4)  *RR  (4) 
XJ=PRS*PZT-PRT*PZS 
C 

PSR=PZT/XJ 
PTR— PZS/XJ 
PSZ— PRT/XJ 
PTZ=PRS/XJ 
C 

DO  100  1-1,6 

HR ( I ) =PSR*HS ( I ) +PTR*HT  ( I ) 

100  HZ(I)=PSZ*HS(I)+PTZ*HT(I) 

R=H  (1)  *RR  (1)  +H  (2)  *RR  (2)  +H  (3)  *RR  (3)  +H  (4)  *RR  (4) 

IF  (NPAR  (5)  -NE.O)  R=TH I CK 
C 

C FORM  STRAIN  DISPLACEMENT  MATRIX 
C 

DO  200  K=1 ,6 
1 = 1 I (K) 

J=JJ  (K) 

B (1 , I)  =HR  (K) 

B (2 , J)  =HZ  (K) 

C 

C TEST  FOR  HOOP  STRAIN  EVALUATION  (AX I SYMMETR I C SOLID) 

C 

IF  (NPAR  (5)  . GT . 0)  GO  TO  190 

C SET  HOOP  STRAIN  .EQ.  RADIAL  STRAIN  IF  ON  C/L  AXIS 

IF  (R.LT.l .OE-6) 

*B(3,  D=B(1  ,1) 

C 

IF  (R.GT. 1 .OE-6) 

*B(3,  l)=H(K)/R 
C 

190  CONTINUE 

B (4 , I ) =HZ  (K) 

200  B (4 , J)  =HR  (K) 

C 

FAC=XJ*R 

RETURN 

END 

SUBROUTINE  GMTN  (FF , IFF, XM.MASS ,NEQB ,NFN, NBLOCK) 

C 

C CALLED  BY?  H I STRY 

C 

COMMON  / JUNK  / NARB.NGM, JFN  (3) , JAT  (3) , I F I LL1  (422) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL2  (14) 

DIMENSION  FF (NEQB.NFN) , IFF  (NEQB.NFN) .MASS(NEQB) .XM(NEQB) 
C 

C GROUND  MOTION  EFFECTS 

C 

IF  (MODEX.EQ.l)  GO  TO  20 

JT=4 

IT-2 
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REWIND  IT 
REWIND  JT 
REWIND  3 
REWIND  9 
C 

20  CONTINUE 

READ  (5J000)  JFN.JAT 
DO  100  1-1,3 
I F (JAT  (I ) ) 50,50,100 
50  JAT(I)-1 
100  CONTINUE 

WRITE  (6,2000)  JFN.JAT 
I F (MODEX.EQ. 1)  RETURN 
C 

NNN=NFN*NEQB 
DO  500  N=1 , NBLOCK 
C 

READ  (3)  MASS 
READ  (9)  XM 
C 

I F (NARB.EQ.O)  GO  TO  200 
READ  (IT)  FF , IFF 
GO  TO  300 

200  DO  250  1=1, NNN 
FF  (I  , 1)  =0.000 
250  IFF  (I  , 1)=0 
C 

300  DO  1+00  1 = 1 , NEQB 
J=MASS  (I) 

IF  (J  .LE.  0)  GO  TO  1+00 
J J=JFN  (J) 

IF  (JJ.LE.O)  GO  TO  1+00 
FF  (I , J J) =-XM  ( I ) 

I  FF  (I  ,JJ)  =JAT  (J) 

1+00  CONTINUE 
C 

500  WRITE  (JT)  F F , IFF 
C 

RETURN 

C 

1000  FORMAT  (6 1 5) 

2000  FORMAT  (////  26H  GROUND  ACCELERATION  INPUT,  //  28X, 

1 1 1 HX-D I RECT I ON , 2X , 1 1HY-D I RECT I ON , 2X , 1 1HZ-D I RECTI  ON , // 

2 26H  TIME  FUNCTION  NUMBER  (S)  =,  3 ( 1 OX , I 3)  / 

3 26H  ARRIVAL  TIME  NUMBER  (S)  =,  300X.I3)  / IX) 

C 

END 

SUBROUTINE  GROUND  (FF , I FF ,XM,MASS,NEQ,NFN) 

C 

C CALLED  BY?  STEP 

C 

C THIS  ROUTINE  MODIFIES  THE  FUNCTION  MULTIPLIERS  AND  ARRIVAL  TIME 
C ARRAYS  TO  ACCOMODATE  INPUT  GROUND  MOTION. 

C 

C *XM*  / TAPE3  / ADDMAS  / 
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C *MASS*  / TAPE7  EMIDS  / 

C *FF*,*IFF*  / TAPE2  / PLOAD  / 

C 

COMMON  /JUNK/  JFN  (3) , J AT  (3) . I F I LL1  (424) 

COMMON  /EXTRA/  MODEX,NT8, IF ILL2 (14) 

C 

DIMENSION  FF  (NEQ.NFN)  , I FF  (NEQ.NFN) , XM  (NEQ) .MASS  (NEQ) 

C 

I F (MODEX.EQ. 1)  GO  TO  20 
C 

NT=3 

IT-2 

KT-7 

REWIND  NT 
REWIND  KT 
REWIND  IT 
C 

C READ  GROUND  MOTION  FUNCTION  REFERENCES  AND  ARRIVAL  TIMES 
C 

20  READ  (5, 1000)  JFN, JAT 
DO  100  1-1,3 
IF  (J AT  ( I ) ) 50,50,100 
50  J AT  ( I ) - 1 
100  CONTINUE 

WRITE  (6,2000)  JFN, JAT 
C 

I F (MODEX.EQ. 1)  RETURN 
C 

READ  (KT)  MASS 
READ  (NT)  XM 
READ  (IT)  F F , IFF 
REWIND  IT 
C 

C MODIFY  FUNCTION  MULTIPLIERS  AND  ARRIVAL  TIMES  DUE  TO 
C INPUT  GROUND  ACCELERAT I ON  (S) 

C 

DO  1*00  1-1  , NEQ 
J-MASS  (I) 

I F (J.EQ.O)  GO  TO  400 
JJ-JFN  (J) 

IF  (JJ.LE.O)  GO  TO  1*00 
FF(I,JJ)  — XM(I) 

IFF  (I  .JJ)-JAT(J) 

1*00  CONTINUE 
C 

WRITE  (IT)  FF , IFF 
RETURN 
C 

C FORMATS 
C 

1000  FORMAT  (6 1 5) 

2000  FORMAT  (38H1G  ROUND  MOTION  INPUT,//  21X, 

1 9HD I RECTI  ON,  / 2 1 X , 1 HX , 3X , 1 HY , 3X, 1HZ,  / 

2 19H  FUNCTION  NUMBERS  =,  13.214  / 

3 19H  ARRIVAL  TIMES  =,  13.214  //  IX) 
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END 

SUBROUTINE  H I STRY 
C 

c CALLS?  LOAD  1 , EM  I D , GMTN , LOAD2 , RESPON , D I SPLR.STRSD 1 
C CALLED  BY?  MAIN 

C 

C TIME  HISTORY  RESPONSE  CALCULATIONS 

C 

COMMON  /SOL/  NB LOCK, NEQB, LL,NF,LB,IFILL4(6) 

COMMON  /ELPAR/  NPAR(U) , NUMNP,MBAND,NELTYP,N1 , N2,N3»N4,N5,MTOT,NEQ 
COMMON  / EM  / AT  (1058)  , I F I LL2  (3022) 

COMMON  / DYN  / NT, NOT, DAMP, DT, I F I LL5  (6) 

COMMON  / JUNK  / NARB.NGM,  I F I LL1  (1+28) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL3  ( 1 4) 

C 

REAL  T(5)  .TT 
C 

COMMON  /one/  A (1 ) 
c***  COMMON  A (7100) 

C 

C 

C***  CALL  TT  I ME  (T  (1) ) 

READ  (5,1000)  NFN , NGM, NAT , NT , NOT , DT .DAMP 
I F (NAT.EQ.O)  NAT= 1 
WRITE  (6,1010) 

WRITE  (6,2000)  NFN, NGM, NAT, NT, NOT, DT, DAMP 
C 

C DYNAMIC  LOADS 

C 

N2=N1+6*NUMNP 

N3=N2+NFN*NEQB 

N4=N3+NFN*NEQB 

I F (N4.GT.MT0T)  CALL  ERROR (MT0T-N4) 

CALL  LOAD  1 (A  (N 1)  , A (N2)  , A (N3)  , NUMNP , NEQB, NFN) 

I F (NGM.EQ.O)  GO  TO  300 
C 

C ADD  GROUND  MOTION  EFFECTS 

C 

I F (MODEX.LT. 1) 

*CALL  EMID  (A  (N 1)  , A (N2)  , NUMNP , NEQB) 

N2=N 1+NEQB*NFN 
N3-N2+NEQB*NFN 
N4=N3+NEQB 
N5=N4+NEQB 

IF  (N5.GT.MT0T)  CALL  ERROR  (N5-MT0T) 

CALL  GMTN  (A  (Nl)  ,A  (N2)  ,A  (N3)  , A (N4)  , NEQB, NFN, NBLOCK) 

C 

300  N2*N 1+NFN*NF*NAT 
N3-N2+NEQB*NF 
N4*N3+NEQB*NFN 
N5=N4+NEQB*NFN 

I F (N5.GT.MT0T)  CALL  ERROR  (N5-MT0T) 

C 

N6=N2+NT*NFN 
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C 


C 

C 

C 

c*** 


c 

c 

c 


320 


C 

c 

c 

c*** 

c 


c 

c 

c 


MAX-  (MT0T-N6) /2 
N7=N6+MAX 

N8-N6+NT 

IF  (N8.GT.MT0T)  CALL  ERROR  (N8-MT0T) 

CALL  L0AD2  (A  (N2)  , A (N3)  , A (N U)  , A (N2)  , A (N6)  , A (N7)  , 

A(N6) , NEQB, NF.NFN, NT, MAX, NBLOCK, NAT) 

NORMAL  RESPONSE 

CALL  TT I ME  (T  (2) ) 

NDS= (NT- 1 ) /NOT 
N2-N 1+NF 
N3-N2+NT 
Ni*=N3+NF*NDS 

I F (N4.GT.MT0T)  CALL  ERROR  (N4-MT0T) 

I F (MODEX.EQ. 1)  GO  TO  320 

CALL  RESPON  (A  (N  1)  , A (N2)  , A (N3)  , NF  , NT ,NDS) 

DISPLACEMENT  RESPONSE 

320  CALL  TT I ME (T  (3) ) ! 320  IS  TRANSFERED  TO  THE  NEXT  LINE 

NSB=NEQB*NBLOCK 
N2-N 1+8*NF 
N3=N2+NF*NDS 

I F (N3-GT.MT0T)  CALL  ERROR  (N3-MT0T) 

CALL  DISPLR  (A  (N 1 ) , A (N 1 ) , A (N2) ,A  (N2)  , NEQB, NF , NDS , NUMNP , NBLOCK , NSB) 

STRESS  RESPONSE 

CALL  TT  I ME  (T  (k) ) 

N2-N 1+NELTYP 
N3=N2+8*NF 
N4=N3+NSB*NF 
N5*N3+NF*NDS 

I F (NL.GT.MTOT)  CALL  ERROR  (NU-MTOT) 

IF  (N5-GT.MT0T)  CALL  ERROR  (N5-MT0T) 

CALL  STRSD1  (A  (N 1)  ,A(N2)  ,A(N3)  ,A(N3)  ,NF  , NSB, NDS, NEQB, NBLOCK) 

CALL  TT I ME  (T  (5) ) 

COMPUTE  AND  PRINT  THE  SOLUTION  TIME  LOG 


TT-O. 

DO  100  1-1, k 
T ( I ) -T  ( 1 + 1 ) -T  (I ) 
100  TT-TT  + T(l) 

T (5)  - TT 
WRITE  (6,3000)  T 


RETURN 

C 

1000  FORMAT  (5 1 5 . 2F 10 .0) 

1010  FORMAT  (1H1./A9H  FORCED  RESPONSE 

1//) 
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2000  FORMAT  (2OHOCONTR0L  INFORMATION  ,// 

2 25H  NUMBER  OF  TIME  FUNCTIONS,  2X.1H-.I5  / 

3 24H  GROUND  MOTION  INDICATOR,  3X, 1H=, 1 5 / 

it  HtH  EQ.O,  NONE,  / 

5 22H  EQ.l,  GROUND  INPUT,  / 

6 24H  NUMBER  OF  ARRIVAL  TIMES,  3X.1H-J5  / 

7 2 1 H NUMBER  OF  TIME  STEPS,  6X.1H-J5  / 

8 22H  OUTPUT  PRINT  INTERVAL,  5X, 1 H-, 1 5 / 

9 10H  TIME  STEP,  1 7X, 1 H=, F 1 1 .5  / 

A 15H  DAMPING  FACTOR,  12X, 1H-.F1 1 .5  ) 

3000  FORMAT  (48H 1 F ORCED  RESPONSE  TIME  LOG,/// 

. 33H  FORM  DYNAMIC  LOADS ,F8.2  // 

. 33H  MODAL  RESPONSE F8.2  // 

. 33H  DISPLACEMENT  OUTPUT F8.2  // 

. 33H  STRESS  OUTPUT F8.2  // 

. 33H  TOTAL  FOR  RESPONSE  ANALYSIS...  ,F8.2  //) 

C 

END 

SUBROUTINE  INDLY  (FF , I F F , AT , NEQ, NFN , NAT.MAXD) 

C 

C CALLED  BY?  STEP 
C 

C THIS  ROUTINE  READS  *NAT*  ARRIVAL  TIME  VALUES  FROM  DATA  INPUT. 

C ARRIVAL  TIMES  ARE  CONVERTED  TO  THE  NEAREST  (INTEGER)  TIME  STEP 

C NUMBER,  AND  ARRIVAL  TIME  REFERENCES  (PREVIOUSLY  STORED  IN 

C * I FF*)  ARE  REPLACED  BY  THE  TIME  STEP  NUMBERS. 

C 

COMMON  /DYN/  NT, NOT, ALFA , DT, BETA , I F I LL 1 (4) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL2  (14) 

C 

DIMENSION  FF  (NEQ, NFN) , IFF  (NEQ, NFN) , AT  (NAT) 

C 

I F (MODEX.EQ. 1)  GO  TO  50 
C 

KT=2 

REWIND  KT 
C 

C READ  ARRIVAL  TIME  DATA 
C 

50  READ  (5,1002)  ( AT  ( I ) , I “1 , NAT) 

WRITE  (6,2004)  ( I , AT  ( I ) , I =1 , NAT) 

MAXD-0 

C 

IF  (MODEX.EQ. 1)  RETURN 
C 

DO  100  1-1, NAT 
100  AT  ( I ) -AT ( I ) /DT 
C 

READ  (KT)  F F , IFF 
REWIND  KT 

DO  300  NF-1 , NFN 
DO  200  N-l.NEQ 
J-l FF  (N , NF) 

JAT-AT(J) 


C 
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IF  ((AT(J)-JAT)  .GE.0.5)  JAT=JAT+1 
JAT=JAT+1 

IF  (JAT.GT.MAXD)  MAXD=JAT 
C 

C NOTE  *MAXD*  IS  THE  LARGEST  TIME  STEP  NUMBER  ASSOCIATED  WITH 
C ANY  ONE  OF  THE  INPUT  DELAY  TIMES.  *MAXD*  IS  USED  FOR 

C CORE  STORAGE  ALLOCATION  DURING  LOAD  VECTOR  CALCULATIONS. 

C 

200  IFF  (N , NF)  = JAT 
300  CONTINUE 
C 

WRITE  (KT)  FF , IFF 
RETURN 
C 

C FORMATS 
C 

1002  FORMAT  (8F10.2) 

2004  FORMAT  (////  38H  ARRIVAL  TIME  VALUES,// 

1 6H  INPUT, 5X, 12HARRIVAL  TIME,/  6H  ORDER, 1 2X, 5HVALUE , // 

2 (I  6,  E 17.4)  ) 

C 

END 

SUBROUTINE  INOUT  ( I D I S , ID, I STR , NUMNP) 

C 

C CALLED  BY?  STEP 

C 

C THIS  ROUTINE  PROCESSES  OUTPUT  REQUESTS  FOR  DISPLACEMENTS  AND 
C ELEMENT  STRESS  COMPONENTS.  TAPE9  IS  USED  TO  SAVE  OUTPUT  SET 
C REQUESTS  (8  REQUESTS  PER  SET),  AND  TAPE8  IS  USED  TO  SAVE  THE 

C STRESS-DISPLACEMENT  TRANSFORMATIONS  FOR  ELEMENT  STRESSES  WHICH 

C ARE  REQUESTED  FOR  OUTPUT. 

C 

C NOTE  *ID*  ANO  *ISTR*  ARE  EQUIVALENCED  IN  BLANK  COMMON  BY  THE 
C CALLING  PROGRAM 

C 

DIMENSION  IDIS  (1)  , ID  (NUMNP, 6)  , ISTR(l)  ,KLM(8,63)  .SSA  (8,63) 

C 

COMMON  /JUNK/  KK 1 , KK2 , I SP 1 , I SP2 , NSD , NSS , I C (6) , KD  (2 , 8) , I S ( 1 2) , 

1 IDUM(32)  ,NUM(100)  , IFILL1  (258) 

COMMON  /ELPAR/  NPAR  (1 4) , I DUM1 , MB AND , NELTYP.N 1 , N2 ,N3 , N4 , N5 , MTOT , 

1 NEQ 

COMMON  /EM/  SA  (42,63)  ,ND, NS, LM(63) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL3  ( 1 4) 

C 

I F (MODEX.EQ. 1)  GO  TO  10 
C 

REWIND  1 
REWIND  8 
REWIND  9 
GO  TO  20 
C 

C RESTORE  MASTER  INDEX  ARRAY  *ID* 

C 

10  REWIND  1 
REWIND  2 
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READ  (2)  ID 
GO  TO  25 
20  CONTINUE 
READ  (8)  ID 
REWIND  8 
C 

25  L=0 
K=0 
C 

C PROCESS  DISPLACEMENT  REQUESTS 
C 

WRITE  (6,1005) 

C 

C 1 . OUTPUT  TYPE 

C 

READ  (5,2000)  KK1.ISP1 
WRITE  (6,4000)  KK1.ISP1 
WRITE  (6,1006) 

C 2.  CARO  READING  LOOP  (TERMINATE  READING  IF  ZERO  NODE  IS  READ) 

C 

100  READ  (5,2000)  NP, 1C 
WRITE  (6,2001)  NP.IC 
I F (NP.GT.O)  GO  TO  1 10 
I F (L.EQ.O)  GO  TO  200 
C 

c 3.  SAVE  LAST  OUTPUT  SET 

C 

I F (MODEX.EQ.O) 

*WR I TE  (9)  KD.L 
GO  TO  200 
C 

C 4.  CONSIDER  SIX  (6)  POSSIBLE  REQUESTS  ON  THIS  CARD 

C 

110  IF  (NP.LE.NUMNP)  GO  TO  112 
WRITE  (6,3010)  NP 

3010  FORMAT  (19H0***  ERROR  NODE  ( , 15. 1 5H)  IS  TOO  LARGE.,  / IX) 

STOP 

112  DO  150  1=1,6 
I I = I C ( I ) 

IF (I  I . EQ.O  .OR.  II.GT.6)  GOTO  100 
K=K+1 
L=L+1 

5.  SAVE  NODE  NUMBER  AND  COMPONENTS  NUMBER  IN  *KD* 

KD  (1  ,L)  =NP 
KD  (2 , L)  = I I 
J J=  I D (NP , I I) 

IF  (JJ.GT.O)  GO  TO  130 
L = L-l 
K-K-l 
GO  TO  140 
130  I D I S (K)  =J  J 
140  IF  (L.LT.8)  GO  TO  150 


C 

c 

c 
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C 

C 6.  SAVE  THIS  OUTPUT  SET  CONSISTING  OF  8 REQUESTS 

IF  (MODEX.EQ.O) 

*WRITE  (9)  KD.L 
L=0 

150  CONTINUE 
GO  TO  100 
C 

C 7.  SAVE  THE  TOTAL  NUMBER  OF  DISPLACEMENT  COMPONENTS  REQUESTED 

C FOR  OUTPUT 

C 

200  NSD-K 
C 

C PROCESS  ELEMENT  STRESS  COMPONENT  REQUESTS 

C 

WRITE  (6,3000) 

C 

C 1 . OUTPUT  TYPE 

C 

READ  (5.2000)  KK2.ISP2 
WRITE  (6.L000)  KK2.ISP2 
K = 1 

ISTR  (1)  =0 
C 

C 2.  CONSIDER  EACH  ELEMENT  TYPE 

C 

DO  500  N= 1 , NELTYP 
C 

READ  (1)  NPAR 
IF  (MODEX.EQ.O) 

*WR I TE  (9)  NPAR 
C 

C 3.  LABEL  ELEMENT  TYPE 

C 

WRITE  (6,3001)  NPAR  ( 1 ) 

C 

C i+.  READ  FIRST  ELEMENT  REQUEST  IN  THIS  GROUP 

C 

READ  (5,2000)  NEL.IS 
WRITE  (6,2001)  NEL.IS 
NUME-NPAR  (2) 

L-0 

NUM  (N)  -0 
C 

C 5.  LOOP  ON  THE  TOTAL  NUMBER  OF  ELEMENTS  OF  THIS  (THE  N-TH) 

C TYPE.  COMPACT  STRESS  TRANSFORMATIONS  WHEN  ELEMENT  NUMBER 

C MATCH  IS  FOUND.  ELEMENT  OUTPUT  REQUESTS  ARE  EXPECTED  IN 

C ASCENDING  ELEMENT  NUMBER  ORDER.  ANY  REQUESTED  ELEMENT 

C NUMBER  LESS  THAN  PREVIOUSLY  READ  NUMBER  WILL  FORCE  THIS 

C LOOP  TO  BE  EXHAUSTED  (I.E.,  TERMINATE  WITH  ZERO  ELEMENT). 

C 

DO  1+00  M-l  ,NUME 
C 

I F (MODEX.EQ.O) 
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*REAO  (1)  ND.NS,  (LM(I)  , 1=1  ,ND)  , ( (SA  (I  , J)  , 1=1  ,NS)  , J=1 , ND) 

I F (MODEX.EQ. 1) 

*READ  (1)  ND.NS,  (LM(I)  , 1=1, ND) 

C 

I F (NEL.NE.M)  GO  TO  400 
KS  = NS 

IF  (KS .GT . 1 2)  KS  = 12 
C 

c 6.  CONSIDER  12  (MAXIMUM)  REQUESTS  FOR  THIS  ELEMENT 

C 

DO  300  1-1, KS 
I I = I S (I) 

I F (I  I . EQ.O)  GO  TO  350 
I F (I  I . GT .NS)  GO  TO  300 
L=L+1 
C 

c 7.  SAVE  THE  ELEMENT  NUMBER  AND  STRESS  COMPONENT  NUMBER  IN  *KD* 

C 

KD  (1  , L)  =NEL 
KD (2.L) =1  I 
C 

c 8.  SAVE  STRESS  TRANSFORMATION  FOR  COMPONENT  *11*  IN  *SSA*  AND 

C COMPUTE  (AND  SAVE  IN  *KLM*)  THE  LOCATION  IN  VECTOR  *ISRT* 

C WHICH  CONTAINS  THE  EQUATION  NUMBER  FOR  THE  J-TH  ELEMENT 

C DEGREE  OF  FREEDOM 

C 

DO  250  J-1 , ND 
I F (MODEX.EQ.O) 

*SSA  (L , J)  = SA  ( II ,J) 

KLM  (L , J) =0 
J J=LM  (J) 

I F (JJ.LE .0)  GO  TO  250 
C 

C 9.  CHECK  FOR  EQUATION  NUMBER  *JJ*  IN  ISTR*.  IF  FOUND,  SET 

C *KLM*  TO  LOCATION  WHERE  FOUND.  IF  NOT  FOUND,  EXTEND  *ISTR* 

C TO  ACCOMODATE  THE  NEW  EQUATION  NUMBER. 

C 

DO  220  NK-1 ,K 

IF  (ISTR(NK)  .NE.JJ)  GO  TO  220 
KLM  (L , J)  =NK 
GO  TO  250 
220  CONTINUE 
ISTR  (K)-JJ 
KLM (L , J) -K 
K-K+l 
I STR  (K) *0 
250  CONTINUE 
C 

c 10.  SAVE  OUTPUT  REQUESTS  AND  TRANSFORMATIONS  TO  ALLOW  STRESS 

C RECOVERY  ONCE  DISPLACEMENTS  ARE  KNOWN 

C 

1 F (L.LT.8)  GO  TO  300 
I F (MODEX.EQ. 1)  GO  TO  290 
WRITE  (9)  KD.L 

WRITE  (8)  ND,  ((SSA  (I  I , JJ) , I 1-1 ,8) , JJ-1 ,ND) , 
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1 ( (KLM  ( I I , J J)  , I 1*1,8)  , J J= I , ND) 

290  L=0 

NUM(N)  =NUM  (N)  +1 
300  CONTINUE 
C 

C 11.  READ  NEXT  REQUEST  AND  BRANCH  BACK  TO  SCAN  FOR  NEW  MATCH 

C 

350  READ  (5,2000)  NEL, IS 
WRITE  (6,2001)  NEL, IS 
C 

400  CONTINUE 
C 

C 12.  SAVE  FINAL  STRESS  OUTPUT  RECORD 

C 

I F (L.EQ.O)  GO  TO  500 
I F (MODEX.EQ. 1)  GO  TO  490 
WRITE  (9)  KD , L 

WRITE  (8)  ND , ( (SSA  ( I I , J J) , I 1*1,8) , J J*1 , ND) , 

1 ( (KLM  ( I I , J J)  ,1  1=1,8)  , J J*1 , ND) 

490  NUM(N)  = NUM(N)  + 1 
500  CONTINUE 
C 

C 13.  SAVE  THE  TOTAL  NUMBER  OF  DISPLACEMENTS  (I.E.,  ENTRIES  IN 

C * I STRrt)  REQUIRED  TO  RECOVER  ELEMENT  STRESSES. 

C 

NSS=K- 1 
C 

C SHIFT  *ISTR*  BACK  IN  BLANK  COMMON  ADJACENT  TO  * I D I S (NSD) * SO 

C THAT  * I D I S*  AND  I STR*  ARE  CONTIGUOUS  IN  STORAGE. 

C 

IF(NSS.LT.l)  RETURN 
DO  550  L= 1 , NSS 
J * NSD+L 

550  IDIS(J)  = ISTR(L) 


RETURN 


C 

C FORMATS 
C 


1005  FORMAT 

1 

1006  FORMAT 

1 

2000  FORMAT 

2001  FORMAT 

3000  FORMAT 
1 

3001  FORMAT 
1 

2 

4000  FORMAT 
1 

2 

3 

4 


(44H1D  ISPLACEMENT  COMPONEN  T,3X, 
29H0  UTPUT  REQUESTS,  //IX) 

(4X, 4HN0DE , 2X.22HDISPLACEMENT  COMPONENT,  / 2X.6HNUMBER, 
6 (3X,  1H*)  , / IX) 

(1315) 

(18,1214) 

(46H 1 S TRESS  COMPONENT  OUTPU  T,3X, 
15HR  E Q U E S T S,  //  IX) 

(//  6X, 23HE  L E M E N T T Y P E.3X, 1H  (, 12, 1H) , // 

8H  ELEMENT, 9X.33HDESIRED  ELEMENT  STRESS  COMPONENTS,  / 


8H  NUMBER, 12 (3X, 1H*)  , / IX) 

(//  25H  CODE  FOR  OUTPUT  TYPE  -,  12/ 
3X.19HEQ.1,  HISTORY  TABLE,  / 

3X, 18HEQ.2,  PRINTER  PLOT,  / 

3X, 17HEQ.3,  MAXIMA  ONLY,  / 

25H  PRINTER  PLOT  SPACING  «,  12  / IX) 
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C 

END 

SUBROUTINE  I NP21  (NUMMAT, MAXTP , NORTHO, NDLS , NOPSET ,NT8SV , NUMNP , X , 

1 Y, Z, DEN, RHO.NTP, EE, DCA, NFACE.LT, PWA ,LOC,MAXPTS) 

C 

C CALLED  BY  ? THDFE 

C CALLS  ? VECTR2 , CROSS2 

C 
C 
C 

C THIS  ROUTINE  READS  AND  PRINTS  ALL  21-NODE  SOLID  ELEMENT  DATA 
C BETWEEN  THE  CONTROL  CARD  AND  THE  ELEMENT  DATA  CARDS 
C 

COMMON  / JUNK/  XLF  (4)  ,YLF  (4)  ,ZLF  (4)  ,TLF  (4)  ,PLF  (A)  , F I LL1  (22)  ,V2  (3) 
COMMON  /EXTRA/  MODEX,NT8 

C DIMENSION  X(l)  ,Y(1)  ,Z(1)  ,DEN(1)  ,RHO(l)  ,NTP(1)  , EE  (MAXTP, 13,1)  . 

1 DCA  (3,3,  1 ) .NFACE  (1)  ,LT(1)  ,PWA(7, 1)  .LOC  (7.  1)  . 

2 MAXPTS  (1) 

DIMENSION  HED  (6) 

C 

C READ  AND  PRINT  OF  MATERIAL  PROPERTIES 
C 

WRITE  (6,3000) 

C 

DO  10  1*1, NUMMAT 
C 

READ  (5,1001)  M,NTP(I)  , DEN  ( I ) ,RHO(l)  , (HED  (N)  ,N=1,6) 

C 

C SET  DEFAULT  VALUES  IF  REQUIRED  AND  CHECK  FOR  INPUT  ERRORS 
C 

IF  (RHO(I)  .EQ.O.O)  RHO(I)  “ DEN(I)  / 386. 4 
IF  (NTP(I)  . EQ  .0)  NTP(I)  - 1 
c 

WRITE  (6,3002)  M,NTP(I)  , DEN  ( I ) , RHO  ( I ) , (HED  (N)  ,N=1,6) 

C 

I F (I  . EQ.M)  GO  TO  2 
WRITE  (6,4001) 

STOP 

C 

2 I F (NTP (M) .LE.MAXTP)  GO  TO  4 
WRITE  (6,4002)  MAXTP 
STOP 

4 NT  - NTP (M) 

C 

C READ  PROPERTIES  FOR  EACH  TEMPERATURE 
C 

DO  6 K=1 ,NT 

READ  (5,1002)  (EE(K,L,M)  .L-1,13) 

WRITE  (6,3003)  (EE (K.L.M) , L-1,13) 

6 CONTINUE 
C 

C TEMPERATURE  CARDS  MUST  BE  ASCENDING  ORDER 
C 
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IF  (NT.EQ.l)  GO  TO  10 
DO  8 J-2.NT 

IF  (EE  (J,  1 ,M)  . GT.EE  (J-l , 1 ,M) ) GO  TO  8 
WRITE  (6,4003) 

STOP 

8 CONTINUE 

10  CONTINUE 

C***  DATA  PORTHOLE  SAVE 

IF  (NT8SV.EQ.0)  GO  TO  12 
DO  11  M= 1 , NUMMAT 

WRITE  (NT8)  M.NTP(M)  ,DEN(M)  ,RHO(M) 

NT  = NTP(M) 

WRITE  (NT8)  ( (EE  (K,L,M)  , L=  1 , 1 3)  ,K=1  ,NT) 

11  CONTINUE 

c 

C MATERIAL  AXIS  ORIENTATION  SETS 
C 

12  IF  (NORTHO . EQ.O)  GO  TO  2 1 
C 

WRITE  (6,3004) 

C 

DO  20  M= 1 .NORTHO 
READ  (5,1003)  N.NI.NJ.NK 
WRITE  (6.3005)  N.NI.NJ.NK 
C 

c***  DATA  porthole  save 
I F (NT8SV.EQ. 1) 

*WRITE  (NT8)  N.NI.NJ.NK 

C CHECK  FOR  ADMI SSAB I L I TY  OF  DATA 
C 

I F (N.EQ.M)  GO  TO  13 
WRITE  (6,4004) 

STOP 

C 

13  IF  (N I . GT .0  .AND.  NI.LE.NUMNP)  GO  TO  5015 
L = N I 

5014  WRITE  (6,4005)  L 
STOP 

5015  I F (N J . GT . 0 .AND.  NJ.LE.NUMNP)  GO  TO  5016 
L * NJ 

GO  TO  5014 

5016  I F (NK . GT.O  .AND.  NK.LE.NUMNP)  GO  TO  14 
L - NK 

GO  TO  5014 

14  CONTINUE 
C 

C GENERATE  DIRECTION  COSINE  ARRAY  FOR  THIS  DATA  SET 
C 

CALL  VECTR2  (DCA(l.l.M)  , X (N I ) , Y (N  I ) ,Z(NI)  ,X(NJ)  ,Y(NJ)  ,Z(NJ)  , I ERR) 
IF (I  ERR. EQ.O)  GO  TO  16 
WRITE  (6,4006) 

STOP 

16  CALL  VECTR2  (V2 , X (N  I ) , Y (N I ) , Z (N I ) , X (NK)  , Y (NK)  ,Z  (NK)  , I ERR) 
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I F (I ERR.EQ.O)  GO  TO  17 
WRITE  (6,4007) 

STOP 

17  CALL  CR0SS2  (DCA (1 , 1 ,M)  , V2 , DCA  (1 , 3, M) , I ERR) 

I F (I ERR.EQ.O)  GO  TO  18 

WRITE  (6,4008) 

STOP 

18  CALL  CR0SS2  (DCA  (1 , 3. M)  , DCA  (1  , 1 , M)  , DCA  (1 , 2,M)  , I ERR) 
I F (I ERR.EQ.O)  GO  TO  20 

WRITE  (6,4009) 

STOP 

20  CONTINUE 
C 

C READ  AND  PRINT  DISTRIBUTED  SURFACE  LOAD  DATA 
C 

21  IF  (NDLS.EQ.O)  GO  TO  31 
C 

WRITE  (6,3006) 


READ  (5,1004)  N.NFACE  (M)  ,LT(M) 

WRITE  (6,3007)  N.NFACE  (M)  ,LT(M) 

C 

C CHECK  FOR  DATA  ADMI SSAB I L I TY 
C 

IF  (N.EQ.M)  GO  TO  22 
WRITE  (6,4010) 

STOP 

22  I F (NFACE  (M)  .GE  . 1 .AND.  NFACE  (M)  .LE  .6)  GO  TO  23 
WRITE  (6,4011) 

STOP 

23  IF  (LT(M)  .EQ.O)  LT  (M)  - 1 

IF  (LT(M)  .GE.l  .AND.  LT(M).LE.2)  GO  TO  24 
WRITE  (6,4012) 

STOP 

24  IF  (LT  (M)  . EQ. 2)  GO  TO  26 

READ  (5.1005)  (PWA  (I  ,M)  , 1 = 1 ,4) 

DO  25  1=2,4 

25  I F (PWA  (I  ,M)  .EQ.O.O)  PWA(I.M)  =PWA(1,M) 

WRITE  (6,3008)  (PWA  ( l , M)  ,1—1,4) 

GO  TO  30 

26  READ  (5.1005)  (PWA ( I, M)  ,1  = 1,7) 

WRITE  (6,3009)  (PWA  (I ,M) , 1 = 1 ,7) 

30  CONTINUE 
C 

c***  DATA  PORTHOLE  SAVE 

IF  (NT8SV.EQ.0)  GO  TO  5031 
DO  5030  M=1 , NDLS 

WRITE  (NT8)  NFACE  (M)  ,LT(M)  , (PWA(I.M)  ,1=1,7) 

5030  CONTINUE 

5031  CONTINUE 

c 

C READ  AND  PRINT  OF  STRESS  OUTPUT  REQUEST  LOCATION  SETS 
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C 

31  IF (NOPSET.EQ.O)  GO  TO  49 
C 

WRITE  (6,3010)  (1,1-1, 7) 

C 

DO  40  M=1 .NOPSET 

READ  (5.1006)  (LOC(I.M)  ,1-1,7) 

WRITE  (6,3011)  M,  (LOC(I.M)  ,1  = 1,7) 

C 

L = 0 

00  35  J=1 . 7 

1 F (LOC  (J,M)  . EQ.O)  GO  TO  36 
L = L + 1 

IF  (LOC(J.M)  .GE.l  .AND.  LOC  (J  , M)  . LE  . 27)  GO  TO  35 
WRITE  (6,4013)  J 
MODEX  = 1 
GO  TO  36 

35  CONTINUE 
C 

36  I F (L.GT.O)  GO  TO  37 
L = 1 

LOC  (1  ,M)  = 21 

37  MAXPTS(M)  = L 
C 

40  CONTINUE 

C***  DATA  PORTHOLE  SAVE 
IF  (NT8SV.EQ.1) 

*WRITE  (NT8)  ( (LOC (I , J)  , 1 = 1 ,7) , J=1 .NOPSET) 

C*** 

c 

C ELEMENT  LOAD  CASE  MULTIPLIERS 
C 

49  WRITE  (6,3012) 

C 

READ  (5,1007)  XLF,YLF,2LF,TLF,PLF 
WRITE  (6,3013)  XLF , YLF , ZLF ,TLF , PLF 
C***  DATA  PORTHOLE  SAVE 
IF (NT8SV.EQ. 1) 

*WR I TE  (NT8)  XLF, YLF, ZLF, TLF, PLF 

c 

RETURN 

C 

C FORMATS 
C 

1001  FORMAT  (2I5.2F10.0.6A6) 

1002  FORMAT  (7F 10.0/6F 10.0) 

1003  FORMAT  (415) 

1004  FORMAT  (3 1 5) 

1005  FORMAT  (7 F 10.0) 

1006  FORMAT  (7  I 5) 

1007  FORMAT  (4 F 10.0) 

C 

3000  FORMAT  (//38H  MATERIAL  PROPERTY  TABLES  ) 

3002  FORMAT  (//22HOMATER I AL  NUMBER  = (, I 3 , 1 H) , / 


0-6 
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1 10H  NUMBER  OF,  / 

2 23H  TEMPERATURE  POINTS  = (J3JH),/ 

3 23H  WEIGHT  DENSITY  = ( .E12.4.1H),/ 

4 23H  MASS  /DENSITY  = (, E 1 2 .4, 1 H) , / 

5 23H  IDENTIFICATION  = (,6a6,1H),// 

6 IX, 1 1HTEMPERATURE.9X.3HE1 1 ,9X,3HE22,9X,3HE33.4X,3HV12,4X,3HV13. 

7 4X,3HV23,8X,3HG12,8X,3HG13.8X,3HG23,3X,7HALPHA-l,3X,7HALPHA-2, 

8 3X.7HALPHA-3./1X) 

3003  FORMAT  (F 12.2.3F12. 1 ,3F7«3.3F1 1 • 1 .3E10.3) 

3004  FORMAT  (//50H  MATERIAL  AXIS  ORIENTATION  , 

1 3X.9HT  ABLE  ,// 

2 28H  SET  NODE  NODE  NODE  ,/ 

3 28H  NUMBER  Nl  NJ  NK,  / IX) 

3005  FORMAT  (417) 

3006  FORMAT  (//51H  DISTRIBUTED  SURFACE  LOAD 

1 11 HT  ABLE  ,/,lX  ) 

3007  FORMAT  (// 7X , 27HLOAD  SET  NUMBER  = ,l6  / 

1 7X , 27HL0AD  SURFACE  ELEMENT  FACE  = , 1 6 / 

1 7X.27HLOAD  TYPE  CODE  - , 1 6/ 1 X) 

3008  FORMAT  (12H  DISTRIBUTED,  11X.4HP  (1) , 1 1X.4HP  (2) , 1 1X.4HP  (3) , 1 1X, 

1 4HP  (4) , / 4X , 8HPRESSURE , 4F 1 5 • 3) 

3009  FORMAT  (12H  HYDROSTAT I C , 10X, 5HGAMMA , 1 1 X , 4HX  (S) , 1 1 X, 4HY (S) , 1 1 X , 

1 4HZ  (S)  , 1 1X.4HX  (N)  , 1 1X.4HY  (N)  , 1 1X.4HZ  (N)  , / 

2 4X.8HPRESSURE,  7F 1 5 - 3) 

3010  FORMAT  (//51H  STRESS  OUTPUT  REQUEST  TABLE, 

Vc  / / 

*8H  SET  ,7  (2X.5HP0INT)  , / 8H  NUMBER  , 7 (4X, 1H  (, I 1 , 1H) ) ,/  IX) 

3011  FORMAT  (18,717) 

3012  FORMAT  (///34H  ELEMENT  LOAD  CASE  ,3X, 

1 2 1 HM  ULTIPLIERS  ,// 

* 3 1 X , 6HCASE  A , 4X , 6HCASE  B.4X.6HCASE  C, 


2 4X.6HCASE  D./1X) 

3013  FORMAT  ( 

1 27H  X-DIRECTION  GRAVITY  = 

2 27H  Y-D I RECT I ON  GRAVITY  = 

3 27H  Z-D I RECT I ON  GRAVITY  = 

4 27H  THERMAL  LOADING 

5 27H  PRESSURE  LOADING 


,4F 10.2/ 

, 4F 10 . 2/ 

,4F 10.2/ 

,4F 10.2/ 

,4F 10.2  //IX) 


C 

4001  FORMAT  (40H0ERR0R*** 

4002  FORMAT  (52HOERROR*** 

1 10H  MAXIMUM  (, 14, 2H) 

4003  FORMAT  (51H0ERR0R*** 

1 7H  ORDER.,  / IX) 

4004  FORMAT  (47HOERROR*** 

4005  FORMAT  (36HOERROR*** 

4006  FORMAT  (38HOERROR*** 

4007  FORMAT  (38HOERROR*** 

4008  FORMAT  (43HOERROR*** 

4009  FORMAT  (43HOERROR*** 

4010  FORMAT  (50H0ERR0R*** 

4011  FORMAT  (40H0ERR0R*** 

4012  FORMAT  (30H0ERR0R*** 

4013  FORMAT  (42HOERROR*** 


MATERIAL  CARDS  OUT  OF  ORDER., /IX) 

NUMBER  OF  TEMPERATURE  CARDS  EXCEEDS  USER, 

, / IX) 

TEMPERATURES  MUST  BE  INPUT  IN  ASCENDING  , 

AXIS  ORIENTATION  CARD  OUT  OF  ORDER., /IX) 
UNDEFINED  NODE  NUMBER  - ,15/  IX) 

VECTOR  IJ  HAS  ZERO  LENGTH., /IX) 

VECTOR  IK  HAS  ZERO  LENGTH., /IX) 

IJ  AND  IK  VECTORS  ARE  PARALLEL .,/ 1 X) 

F3  AND  FI  VECTORS  ARE  PARALLEL .,/ 1 X) 

SET  NUMBERS  MUST  BE  IN  ASCENDING  ORDER, /IX) 
INVALID  SURFACE  FACE  NUMBER., /IX) 

INVALID  LOAD  TYPE., /IX) 

INVALID  OUTPUT  POINT  NUMBER  - , l6  / IX) 


C 
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C 

END 

SUBROUTINE  I NTH  I S (NLP , P, NFN , MXLP , KN) 

C 

C CALLED  BY?  STEP 

C 

C THIS  ROUTINE  READS  TIME  FUNCTIONS  FROM  CARD  INPUT. 

C 

C NUMBER  OF  TIME  POINTS  PER  FUNCTION  STORED  IN  *NLP*.  AND  *P* 

C CONTAINS  (T , F (T) ) PAIRS  FOR  EACH  FUNCTION.  *MXLP*  IS  THE 

C MAXIMUM  NUMBER  OF  TABLE  POINTS  (ENTRIES)  USED  TO  DESCRIBE  ANY 
C ONE  OF  THE  FUNCTIONS. 

C 

DIMENSION  NLP  (NFN) , P (KN , 1) 

C 

COMMON  /ELPAR/  NPAR(14) , NUMNP,MBAND,NELTYPpNl , N2,N3,N4,N5,MT0T,NEQ 
COMMON  /JUNK/  HED  (12) , I F I LL1  (406) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL2 (14) 

C 

MXLP=0 
NF=  1 
C 

C CARD  READING  LOOP 
C 

WRITE  (6,2002) 

50  NF2=2*NF 
NF1-NF2-1 

READ  (5,1000)  NLP  (NF) ,SFTR,HED 
IF  (ABS(SFTR)  .LT.  1 .OD-8)  SFTR-1 .ODO 
IF  (NLP(NF)  .GT.MXLP)  MXLP  * NLP  (NF) 

WRITE  (6,2000)  NF.NLP(NF) .SFTR.HED 

N3  * N2+KN*MXLP 

I F (N3-GT.MT0T)  CALL  ERROR  (N3-MT0T) 

C 

NN-NLP  (NF) 

READ  (5,1001)  ( P(NF1,L)  ,P(NF2,L)  .L-l.NN) 

WRITE  (6,2001)  (L,P(NF1,L)  ,P(NF2,L)  , L-l.NN) 

C 

I F (MODEX.EQ. 1)  GO  TO  105 
C 

C SCALE  FUNCTION  VALUES 

C 

DO  100  K-1 ,NN 

100  P (NF2 , K)  = P (NF2,K)  * SFTR 
C 

C TEST  THE  TIME  VALUE  FOR  THE  FIRST  INPUT  TABLE  POINT.  THIS  FIRST 
C POINT  MUST  BE  AT  TIME  ZERO. 

C 

105  IF  (ABS  (P  (NF 1,1))  .LT.  1 .00-8)  GOTO  110 
WRITE  (6,3000)  NF 
STOP 

110  CONTINUE 
NF-NF+1 

IF  (NF . LE .NFN)  GO  TO  50 
RETURN 
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C 

c FORMATS 

C 


1000  FORMAT 

1001  FORMAT 

2000  FORMAT 

1 

2 

3 

4 

5 

2001  FORMAT 

2002  FORMAT 
3000  FORMAT 

1 


(I5.F10.0, 12A5) 

(12F6.0) 

(//  26H  TIME  FUNCTION  NUMBER  = (.I3.1H) . // 

5X, 2 1 HNUMBER  OF  POINTS  = (,  13.  1H) , / 

5X , 2 1 HSCALE  FACTOR  ■ (,E12.4,  1H)  , / 

5X , 2 1 HDESCR I PT I ON  = (,  12A5,  1H) , // 

8X,5HINPUT,8X,4HTIME,4X,8HFUNCTI0N,  / 8X.5H0RDER, 

2 (7X.5HVALUE) , / IX) 

(8x, 15, 2E12.4) 

(36H1T  IME  FUNCTION  DATA,  /IX) 
(30H0***  ERROR  FUNCTION  NUMBER  ( , I 4 , 1 OH)  DOES  NOT, 
20H  BEGIN  AT  TIME  ZERO.,  / IX) 


END 

SUBROUTINE  INVECT  (VA , XM, I EQ.NBLOCK, NEQB.NV, I FPR) 


C 

C CALLED  BY?  SSPCEB 
C 

COMMON  /SOL/  I DUM  (10) , NFO 
COMMON  /TAPES/NSTI F ,NRED,NL,NR,NT ,NMASS 
DIMENSION  VA(NEQB.NV)  , XM  (NEQB)  , IEQ(1) 

C 

NV1=NV-1 -NFO 
KK=  1 
I ND=0 

90  NBV=KK* ( (NV1-1) /NBLOCK+1) 

IF  (NBV.GT.NEQB)  NBV=NEQB 
IF  (NBV.EQ.NEQB)  IND-1 
NBVN=0 
I C0UNT=0 
LL=0 
C 

REWIND  NMASS 
REWIND  NSTIF 
60  READ  (NMASS)  XM 

READ  (NSTIF)  (VA  (I  , 1)  , 1 = 1 ,NEQB) 

I COUNT* I COUNT+1 
DO  20  1=1 .NEQB 

IF  (VA  (I , 1)  .EQ.  O.ODO)  GO  TO  20 
VA  ( I , 1 ) “XM  ( I ) /VA (1,1) 

20  CONTINUE 

C 

NNV-NEQB/NBV 
DO  40  L-l.NBV 
RT=0 .0 
NN=L*NNV 
DO  34  1=1 , NN 

IF  (VA  (1,1)  .LT.  RT)  GO  TO  34 
RT=VA  (I  , 1) 

I J=l 

CONTINUE 
DO  30  I =NN,NEQB 


34 
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IF  (VA  (I , 1)  .LE.  RT)  GO  TO  30 
RT-VA  (I  , 1) 

I J=  I 

30  CONTINUE 

I F (VA  (I J, 1)  .NE.  O.ODO)  GO  TO  32 
NBVN=NBVN+1 
GO  TO  40 
32  LL=LL+1 

I EQ  (LL)  = (I  COUNT-  1)  *NEQB+I  J 
IF  (LL.GE.NV1)  GO  TO  50 
VA  ( I J , 1) “O.ODO 
40  CONTINUE 

IF  (IND.EQ.l)  GO  TO  45 

IF  ((NBVN.EQ.O)  .OR.  ( I COUNT . EQ. NBLOCK) ) GO  TO  45 
NBV=KK*  ( (NV1-LL-1) / (NBLOCK- I COUNT) +1) 

IF  (NBV.GT.NEQB)  NBV=NEQB 
NBVN=0 
C 

45  IF  (ICOUNT.LT. NBLOCK)  GO  TO  60 

IF  (IND.EQ.l)  GO  TO  47 
KK=2*KK 
GO  TO  90 

47  WRITE  (6, 1000) 

STOP 

C 

50  REWIND  NMASS 

REWIND  NR 
REWIND  NT 
NSH1-NF0+1 
NSH2=NF0+2 
DO  100  L=1 .NBLOCK 
READ  (NMASS)  XM 
I F (NFO.LE.O)  GO  TO  1 15 
READ  (NT)  VA 
1 15  DO  120  1=1 ,NEQB 
VA  (I  ,NSH1)  =XM  (I) 

DO  120  J=NSH2 , NV 
120  VA ( I , J) =0 . 0 
DO  140  K= 1 , NV1 
I I = I EQ  (K) 

NLE* (L-l) *NEQB 
NRI=L*NEQB 

IF  ( I I -NLE)  140,140,160 
160  IF  (NR  I - II ) 140,180,180 
180  11=11 -NLE 

VA ( I I , K+NSH 1) =1 . 

140  CONTINUE 

WRITE  (NR)  VA 
100  CONTINUE 

IF  (I FPR.EQ. 1) 

* WRITE  (6,1010) 

IF  (IFPR.EQ.l) 

* WRITE  (6,1020)  (IEQ(I)  , l-l.NVl) 


C 


RETURN 
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C 

1000  FORMAT  (37HO***ERROR  SOLUTION  STOP  IN  *INVECT*.  / 12X, 

1 42H I NSUFF I C I ENT  NUMBER  OF  FINITE  EIGENVALUES.,  / IX) 

1010  FORMAT  (20HOPR I NT  OF  VECTOR  I EQ  ) 

1020  FORMAT  (1  HO, 20  I 6) 

END 

SUBROUTINE  JACOBI  (A , B , X, E I GV, D , N , RTOL, I FPR) 

C 

C CALLED  BY?  EIGSOL 
C 

D I MENS  I ON  A (N , N)  , B (N , N)  , X (N , N)  , E I GV  (N)  , D (N) 

C 

NSMAX=1 5 
DO  10  1=1, N 
D (l)-A(l  , D/B(l  , I) 

10  EIGV(I)-D(I) 

DO  30  1=1, N 
DO  20  J=1 , N 
20  X ( I , J) =0 . 

30  X (I  , 0=1.0 

IF(N.EQ.l)  RETURN 
NSWEEP-0 
NR=N- 1 
C 

C WE  START  ITERATION 
40  NSWEEP-NSWEEP+1 

IF  (I  FPR.EQ.  1) 

*WRITE  (6,1000)  NSWEEP 
EPS=  (0.01**NSWEEP)  **2 
DO  50  J=1 , NR 
JJ=J+1 

DO  50  K=J J , N 
TT=A  (J  , K)  *A  (J , K) 

TB=A  (J , J)  *A  (K , K) 

EPTOLA=ABS (TT/TB) 

TT=B  (J , K)  *B  (J , K) 

TB=B  (J,J)  *B  (K, K) 

EPTOLB=TT/TB 

IF  ((EPTOLA.LT.EPS)  .AND.  (EPTOLB.LT.EPS))  GO  TO  50 
AKK=A  (K , K)  *B  (J , K)  -B  (K, K)  *A  (J,K) 

AJ  J=A  (J , J)  *B  (J , K)  -B  (J  , J)  *A  (J  , K) 

AB=A  (J,J)  *B  (K, K)  -A  (K , K)  *B  (J,  J) 

CHECK-  (AB*AB+4 .0*AKK*AJJ) /4 .0 
IF  (CHECK)  60,60,70 
60  WRITE  (6,1004)  CHECK 
STOP 

70  SQCH=SQRT  (CHECK) 

D1-AB/2.0+SQCH 
D2-AB/2 .O-SQCH 
DEN-D1 

IF  (ABS  (D2)  .GT.  ABS(Dl))  DEN-D2 
IF  (DEN)  90,80,90 
80  CA=0 . 

CG=-A(J,K)/A(K,K) 

GO  TO  100 
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90  CA-AKK/DEN 

CG=-AJ J/DEN 
C 

C WE  PERFORM  THE  GENERALIZED  ROTATION 
100  IF  (N-2)  95,180,95 
95  JP1=J+1 

JM 1 = J — 1 
KP1-K+1 
KM1-K-1 
C 

IF  (JM1-1)  120,110,110 
110  DO  105  I “1 , JM1 

AJ*A  (I  , J) 

BJ-B  (I  , J) 

AK=A  (I  ,K) 

BK=B  (I  ,K) 

A (I , J) =AJ+CG*AK 
B (I , J) =BJ+CG*BK 
A (I ,K) =AK+CA*A J 
105  B (I , K) =BK+CA*BJ 
C 

120  IF  (KP1-N)  130,130,140 

130  DO  125  l-KPl.N 

A J=A  (J,  I) 

B J=B  (J,  I) 

AK=A  (K, I) 

BK=B  (K, I) 

A (J, I) =AJ+CG*AK 
B (J, I) =BJ+CG*BK 
A (K , l)=AK+CA*AJ 
125  B (K, I) =BK+CA*BJ 
C 

140  IF  (JP1-KM1)  i5O.i5O.l8O 

150  DO  160  I-JP1.KM1 

AJ=A  (J,  I) 

BJ=B  (J,  I) 

. AK«A(I,K) 

BK=B  (I  , K) 

A (J,  l)=AJ+CG*AK 
B (J , l)«BJ+CG*BK 
A (I ,K) =AK+CA*AJ 
160  B (I ,K) =BK+CA*BJ 
180  AK-A(K,K) 

BK-B  (K , K) 

A (K , K) -AK+2*CA*A  (J , K) +CA*CA*A  (J , J) 
B (K , K) -BK+2*CA*B  (J , K) +CA*CA*B  (J , J) 
A (J , J)  -A  (J , J)  +2*CG*A  (J , K)  +CG*CG*AK 
B (J , J)  “B  (J , J)  +2*CG*B  (J , K)  +CG*CG*BK 
A (J , K) *0 .0 
B (J  , K) *0 .0 
C 

C UPDATE  EIGENVECTORS 
DO  190  1-1, N 
XJ-X  (I , J) 

XK-X  (I  , K) 
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X (I  ,J)=XJ+CG*XK 
190  X(I,K) =XK+CA*XJ 
C 

50  CONTINUE 
C 

DO  220  1=1, N 

220  E IGV(I)  =A  (I  , I) /B  (I  , I) 

I F (I FPR.EQ.O)  GO  TO  227 
WRITE  (6,1005) 

WRITE  (6,1002)  (EIGV(I)  , 1 = 1 ,N) 

227  CONTINUE 
C 

C CHECK  FOR  CONVERGENCE 
DO  240  1=1 , N 
TOL=RTOL*D  (I) 

D I F=ABS (E I GV  ( I ) -D  ( I ) ) 

IF  (DIF.GT.TOL)  GO  TO  300 
240  CONTINUE 
C 

C CHECK  IF  ALL  OFF-DIAG  ELEMENTS  ARE  SATISFACTORILY  SMALL 

EPS=RT0L**2 
DO  260  J=1 , NR 
JJ=J+1 

DO  260  K=J J , N 
TT=A  (J.K)  *A  (J.K) 

TB=A  (J,  J)  *A  (K , K) 

EPSA=ABS  (TT/TB) 

TT=B  (J.K)  *B  (J.K) 

TB=B  (J,  J)  *B  (K.K) 

EPSB=TT/TB 

IF  ( (EPSA.LT.EPS)  .AND.  (EPSB.LT.EPS) ) GO  TO  260 
GO  TO  300 
260  CONTINUE 
C 

DO  310  1=1 ,N 
DO  310  J=l ,N 
B (J , I ) =B  ( I , J) 

310  A (J , I ) =A  ( I , J) 

RETURN 

C 

300  DO  320  1=1 ,N 
320  D ( I ) =E I GV  ( I ) 

IF  (NSWEEP.LT. NSMAX)  GO  TO  40 
DO  330  1=1, N 
DO  330  J=l ,N 
B (J , I ) =B  ( I ,J) 

330  A (J,  l)=A  (I  , J) 

RETURN 

C 

1000  FORMAT  (27HOSWEEP  NUMBER  IN  *JACOBI*  =,  1 4) 

1002  FORMAT  (1H  .12E11.4) 

1004  FORMAT  (37HO***ERROR  SOLUTION  STOP  IN  *JAC0BI*.  / 12X, 

1 8HCHECK  = , E20.14  / IX) 

1005  FORMAT  (36HOCURRENT  EIGENVALUES  IN  *JACOBI*  ARE,  / IX) 

C 
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END 

C 

C CALLED  BY?  QTSHEL 
C 

C THIS  SUBROUTINE  COMPUTES  THE  BENDING  MOMENT  FIELD  IN  A LCCT 
C PLATE  BENDING  ELEMENT  WITH  6,  5,  k OR  3 NODAL  POINTS 
C 
C 

C * * * * ft  * 

c 

C M, A , B , C , H 
c W(l) 

C RX(I)/RY(I) 

C RM  ( I ) 

C 
C 

C *****  * 

c 

C BMT  ( I , J ) 

C 

c 
c 
c 

SUBROUTINE  LCTMOM  (M) 

COMMON  /TR I ARG/  A (3)  , B (3)  , HMT  (3)  , H (3)  . C (3 , 3)  , SMT  (3,3), 

1 BMT  (3,3)  , FT  (12)  , W (3)  , RX  (3)  ,RY(3)  ,RM(3)  , ST  ( 1 2 . 1 2) 

DIMENSION  U (3)  , Q (3.6)  ,CV(3)  , I PERM  (3)  ,TX(3)  ,TY(3)  ,RH(3) 
EQUIVALENCE  (Q  ( 1 ) . ST  ( 1 ) ) 

DATA  IPERM  /2.3.1/ 

AREA  = A(3)*B(2)-A(2)*B(3) 

DO  150  1*1,3 
J = I PERM ( I ) 

X = A (I)  **2+B  (l)**2 
U(l)  = - (A(I)*A(J)+B(I)*B(J))/X 
X =SQRT  (X) 

Y = 2.*AREA/X 
RH  (I)  * 0.0 

IF  (I  . L E . M)  RH  ( I ) * 2 . *Y*RM  ( I ) 

TX  ( I ) = Y* A ( I ) /X 
TY  (I)  * -Y*B  (I)  /X 
A 1 * A ( I ) /AREA 
A2  * A (J) /AREA 
B 1 - B ( I ) /AREA 
B2  - B (J)  /AREA 
Q (1 , I)  - B1*B1 
Q(2,  I)  - A 1 *A  1 
Q(3.  I)  - 2.*  A 1 *B  1 
Q (1 , 1+3)  - 2.*  B1*B2 
Q(2,  1+3)  * 2.*  A 1 *A2 
150  Q (3, 1+3)  * 2.*  (A1*B2+A2*B1) 

DO  300  1=1,3 
J - I PERM ( I ) 

K - I PERM (J) 

FAC  - H(l)**3/  12.0 
A2  = A (J) 


*********  INPUTS  *************** 
AS  IN  SLCCT . 

1=1. ..3  CORNER  Z-D I SPLACEMENTS 

1=1. ..3  CORNER  X/Y  ROTATIONS 

1=1. ..3  IF (M.GT.O) , MIDPOINT  SIDE  ROTATIONS  (DEVIATIONS 
FROM  NORMAL  SLOPE  LINEARITY) 

********  OUTPUTS  **************** 

1=1... 3,  J=1...3  BENDING  MOMENT  COMPONENTS  MOM-XX 
(J=l),  MOM-YY  (J=2) , AND  MOM-XY  (J=3)  AT  THE  CORNERS 
1=1. ..3  ASSOCIATED  WITH  THE  INPUT  DISPLACEMENTS 
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A3  = A (K) 

B2  = B (J) 

B3  = B (K) 

U2  - U(J) 

U3  - U(K) 

W2  = 1 .0  - U2 
W3  - 1.0  - U3 

C21  = -(2.0+W2)*  B2  - (2.0+U3)*  B3  + TX  (K)  - TX  (J) 

C22  * B2*  W2  - B3*  U3  + TX  (K)  + TX  (J) 

C 3 1 = - (2 .0+W2)  * A2  - (2.0+U3)*  A3  + TY  (K)  - TY  (J) 

C 32  = A2*  W2  - A3*  U3  + TY  (K)  + TY  (J) 

C52  = B2-  B3*  W3  “ TX (K) 

C62  = A2-  A3*  W3  - TY(K) 

C82  = B2*  U2-  B3  ” TX (J) 

C92  = A2*  U2-  A3  " TY (J) 

C51  = 4.0*  B3  " C52 

C6l  = 4.0*  A3  - C62 

C81  = -4.0*  B2  - C82 

C9 1 = -4.0*  A2  - C92 

DO  250  L=1 , 3 
Q11  = Q CL, I) 

Q22  = Q (L , J) 

Q33  = Q(L.K) 

QI2  = Q(L,  1+3) 

Q2 3 = Q (L , J+3) 

Q3 1 = Q(L,K+3) 

Q1  = Q22  - Q33 
Q2  = Q22  - Q23 

Q3  = Q33  - Q23 

Q4  = Q2  3 + Q1 

05  = Q2  3 - Q1 

250  CV  (L)  = (-6 . *Q1  1+3.*((U3-W2)  *Q1+(U3+W2)*Q23))*W(I) 

1 + (6 . *Q22+3 . *W3*Q4) *W  (J)  + (6.*Q33+3-*U2*Q5) *W  (K) 

2 +( (C21*Ql+C22*Q23+4.* (B2*Q3 1 -B3*Q1 2) ) *RX (I) 

3 + (C31*Q1+C32*Q23+4.*(A2*Q31-A3*Q12))*RY(I) 

4 + (C5 1 *Q22+C52*Q3) *RX (J)  + (C6l*Q22+C62*Q3) *RY  (J) 

5 + (C8l*Q33+C82*Q2)*RX(K)  + (C91*Q33+C92*Q2)  *RY  (K) 

6 + Q5*RH  (J)  + Q4*RH(K))/2. 

DO  300  J- 1,3  x 

BMT(I,J)  = -FAC*(C(J,1)*CV(1)+C  (J,2)*CV(2)+C(J,3)*CV(3)) 

300  CONTINUE 
RETURN 
END 

SUBROUTINE  LCT9ST  (SLCT9 . NODE , XLCT9) 


C 

C CALLED  BY?  STRETR 
C 

C THIS  SUBROUTINE  FORMS  THE  MOMENT  RESULTANT/DISPLACEMENT  TRANSFOR- 
C MAT  I ON  MATRIX  FOR  A 3 NODE,  LCCT-9.  TRIANGULAR  BENDING  ELEMENT. 

C 

c****  I N P U T S 


C 

C A.B.C.H 

C 

C NODE 


AS  IN  SLCCT . 

NODE  (1,2  OR  3)  AT  WHICH  THE  MOMENT/DISPLACEMENT 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


C IS  FORMED 

C 

C****  OUTPUTS 
C 

C SLCT90.J)  1—1  — 3.  MOMENT  RESULTANTS  AT  TRIANGLE 

C VERTEX  (NODAL  POINT)  NUMBER  *NODE*  ...  M (XX) / 

C (1  = 1),  M (YY)  / ( I =2)  , M(XY)/(I=3).  TRANSVERSE  PLATE 

C DISPLACEMENTS  W(1)/(J-1),  W(2)/(J=2),  W(3)/(J-3), 

C AND  IN-PLANE  ROTATIONS  RX  (1)  / (J-4)  , RX  (2) / (J=5)  , 

C RX  (3)  / (J=6)  , RY  (1)  / (J=7)  , RY  (2)  / (J=8)  , RY  (3)  / (J=9)  . 

C 

COMMON  /TRIARG/ 

1 A (3)  , B (3)  , HMT  (3)  ,H(3)  . c (3.3)  , SMT  (3,3)  ,BMT(3.3)  , 

1 FT  ( 1 2)  ,U  (3)  ,TX(3)  ,TY(3)  ,RM(3)  , ST  ( 1 2 , 1 2) 

C 

DIMENSION  Q (3,6)  , I PERM  (3)  ,SLCT9(3,9)  ,XLCT9(3.9) 

C 

EQUIVALENCE  (Q(l).ST(l)) 

C 

DATA  I PERM/2 , 3,1/ 

C 

AREA  = A (3)  * B (2)  - A (2)  * B (3) 

C 


C 


DO  150  1=1,3 
J = I PERM  ( I ) 

X = A (I)  **2  + B (I)  **2 

U(l)  = - (A  ( I ) * A (J)  + B(l)*  B (J) ) / X 

X =SQRT  (X) 

Y = 2.0*  AREA/  X 
TX(I)  = Y*  A (I)  / X 
TY  ( I ) - -Y*  B(l)/  X 
A 1 = A ( I ) / AREA 
A2  = A (J)  / AREA 
B 1 = B ( I ) / AREA 
B2  = B (J)  / AREA 


Q (1 , 1 ) 

= 

Bl* 

Bl 

Q (2 , 1 ) 

* 

Al* 

Al 

Q (3. 1 ) 

m 

2.0* 

Al* 

Bl 

Q (1 , 1+3) 

= 

2.0* 

Bl* 

B2 

Q(2,  1+3) 

* 

2.0* 

Al* 

A2 

Q (3, 1+3) 
150  CONTINUE 

= 

2.0* 

(Al* 

B2+  A2*  Bl) 

I = NODE 
J = I PERM  (I) 

K = I PERM  (J) 

FAC  = H(l)**3/  12.0 
A2  = A (J) 

A3  = A (K) 

B2  = B(J) 

B3  = B (K) 

U2  = U(J) 

U3  = U (K) 

W2  = 1 .0  - U2 

W3  = 1 .0  - U3 
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C21 

8 

- (2.0+W2) * B2  - 

(2.0+U3)  * 

B3 

+ 

TX  (K)  - TX  (J) 

C22 

= 

B2*  W2  - B3*  1 

J3 

+ 

TX  (K)  + TX  (J) 

C31 

= 

- (2.0+W2)  * A2  - 

(2.0+U3)* 

A3 

+ 

TY  (K)  - TY  (J) 

C32 

= 

A2*  W2  - A3*  1 

U3 

+ 

TY  (K)  + TY  (J) 

C52 

= 

B2-  B3*  W3 

- 

TX  (K) 

C62 

= 

A2-  A3*  W3 

- 

TY  (K) 

C82 

m 

B2*  U2-  B3 

- 

TX  (J) 

C92 

= 

A2*  U2-  A3 

- 

TY  (J) 

C51 

= 

4.0*  B3  - C52 

C6l 

= 

4.0*  A3  - C62 

C8l 

= 

-4.0*  B2  - C82 

C91 

= 

-4.0*  A2  - C92 

do  ; 

25C 

) L-1,3 

Qll 

= 

Q (L,  1) 

Q22 

= 

Q(L.J) 

Q33 

= 

Q (L , K) 

Q 1 2 

= 

Q(L,  1+3) 

Q23 

= 

Q (L , J+3) 

Q31 

= 

Q (L , K+3) 

Ql 

= 

Q22  - Q33 

Q2 

= 

Q22  - Q2 3 

Q3 

= 

Q33  - Q2 3 

Q4  = Q2  3 + Q1 

Q5  = Q23  ~ Q1 

C CURVATURE  - DISPLACEMENT  RELATION 

XLCT9  (L , I ) * -6.*Q1  1+3.*((U3-W2)*Q1+(U3+W2)*Q23) 

XLCT9  (L , J)  = 6.*Q22+3.*  W3*Q4 

XLCT9  (L , K)  = 6.*Q33+3-*  U2*Q5 

XLCT9  (L , I +3)  - (C21*Q1+C22*Q23+4.*(B2*Q31-B3*Q12))*  0.5 
XLCT9 (L . J+3)  = (C51*Q22+C52*Q3)  * °-5 

XLCT9 (L , K+3)  = (C8 1 *Q33+C82*Q2)  * 0.5 

XLCT9  (L , 1+6)  = (C31*Q1+C32*Q23+4.*(A2*Q3I-A3*Q12))*  0.5 
XLCT9(L,J+6)  = (C6l*Q22+C62*Q3)  * 0.5 

XLCT9(L,K+6)  = (C91*Q33+C92*Q2)  * 0.5 

250  CONTINUE 

C MOMENT  - DISPLACEMENT  RELATION 

DO  300  1=1,3 
DO  290  J=1 ,9 
DUM  =0.0 
DO  280  K-1,3 

280  DUM  = DUM  + C(I,K)*  XLCT9(K,J) 

SLCT9  ( I ,J)  = -FAC*  DUM 
290  CONTINUE 
300  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  LOAD  (KTYPEE , PRR , YREF F , NF ACE) 

C 

C CALLS?  DERIV 

C CALLED  BY?  BR I CK8 

c 

COMMON/EM/LM  (24) ,ND,NS,  ES (24,24)  ,RF (24,4)  ,XM(24) ,SA  (12,24)  , 
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SF  (12,4) , I F I LL2  (3048) 

COMMON  /JUNK/  ETA  (3)  , DET.MLD  (4)  , KLD  (4)  .MULT  (4)  , UP  (8)  , I NP  (8)  , 

A (3,3)  ,P  (3,11)  ,B  (3,3) , xx  (8,3)  ,Q(n)  ,dl(8)  , i fll  (206) 

DIMENSION  KTYPEE  (1)  , PRR  (1)  , YREFF  (1)  ,NFACE(1) 

COMMON  /GASS  / DUM  (1  2)  , XK  (4)  , DDUM  ( 1 2)  , WGT  (4)  , I PERM  (3) 

DIMENSION  KCRD  (6) , FVAL (6) , KFACE (6,4) 

C 

DATA  KFACE  / 1,  4,  2,  1,  6,  2, 

1 2,  3,  3,  4,  7.  3, 

2 6,  7,  7,  8,  8,  4, 

3 5,  8,  6,  5,  5,  1/ 

DATA  KCRD  / 1,1, 2, 2, 3, 3/ 

DATA  FVAL  / 1 . , - 1 . , 1 . , - 1 . , 1 . , - 1 ./ 

C 

C 

DO  700  KK=1 ,4 
NNN-KLD  (KK) 

IF(NNN)  700,700,10 
10  KTYPE=KTYPEE (NNN) 

PR=PRR  (NNN) 

YREF=YREFF  (NNN) 

KF-NFACE  (NNN) 

C 

C INTEGRATE  OVER  THE  SURFACE 

C 

ML  = KCRD  (KF) 

MM  - I PERM  (ML) 

MN  = I PERM  (MM) 

ETA  (ML)  - FVAL  (KF) 

DO  300  LX  * 1 ,4 
ETA  (MM)  - XK  (LX) 

DO  300  LY  * 1,4 
ETA (MN)  * XK  (LY) 

CALL  DER I V (3 , SA) 

C 

C COMPUTE  DIRECTION  COSINES  OF  NORMAL  TO  SURFACE 

C 

A 1 = (A(MM,2)*A(MN,3)-A(MM,3)*A(MN,2)) 

A2  = (A  (MM,  3)  *A  (MN,  1)  -A  (MM,  1)  *A  (MN,  3) ) 

A3  » (A  (MM,  1 ) *A  (MN , 2)  -A  (MM,  2)  *A  (MN , 1) ) 

AA*SQRT (A  1 **2+A2**2+A3**2) 

A 1 = Al/AA 
A2  - A2/AA 
A3  - A3/AA 
C 

C COMPUTE  FIRST  FUND.  FORM  (SIN  / ) 

C 

AA  - 0. 

BB  * 0. 

CC  = 0. 

DO  200  1*1,3 

AA-AA+A (MM, l)**2 
CC*CC+A (MN, I) **2 
200  BB  = BB  + A (MM, I)  *A (MN, I) 

C=SQRT(AA*CC  - BB*BB) 
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C 

C COMPUTE  PRESSURE, LOAD  COMPONENTS,  STORE  IN  R 

C 

IF  (KTYPE.EQ.2)  GO  TO  170 
FORCE  - PR 
GO  TO  185 
170  YY  = 0. 

DO  180  1-1,8 

180  YY  = YY  + Q(I)*XX(I,2) 

YY  = YY  - YREF 
FORCE  - -PR*YY 
I F (YY.GT.O.)  FORCE  = 0. 

185  CONTINUE 

TS=FORCE*WGT  (LX) *WGT (LY) *C 
C 

DO  190  I -1,4 
N = KFACE  (KF, I) 

QQ=TS*Q(N) 

k-3*n 

RF  (K-2 , KK)  = RF  (K-2 , KK)  + QQ*A1 

RF  (K-l.KK)  = RF  (K-l.KK)  + QQ*A2 

RF (K  , KK)  = RF  (K  , KK)  + QQ*A3 

190  CONTINUE 
C 

300  CONTINUE 
C 

700  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  LOADV  (NLP, P , B , FF , I F F , LDOF .NEQ.NFN, KN) 

C 

C CALLED  BY?  STEP 

c 

C THIS  ROUTINE  COMPUTES  THE  SYSTEM  LOAD  VECTORS  *B*  AT  EACH  OF  THE 
C *NT*  SOLUTION  TIME  STEPS  AND  SAVES  THEM  ON  TAPE2. 

DIMENSION  NLP  (NFN)  , P (KN , 1)  , B (NEQ)  , FF  (NEQ.NFN)  , I FF  (NEQ,  NFN)  , 

1 LDOF (NEQ) 

C 

COMMON  /DYN/  NT, NOT, ALFA, DT, BETA, I F I LL  (4) 
c * 

C READ  FUNCTION  MULTIPLIERS  AND  ARRIVAL  TIME  STEPS.  THESE  ARRAYS 

C (*FF*  AND  * I F F *)  ARE  OVER-WRITTEN  WITH  LOAD  VECTORS  *B*  IN  THIS 

C ROUTINE. 

C 

KT-2 

REWIND  KT 
READ  (KT)  FF  , I FF 
REWIND  KT 
C 

TETA-1  .If 
DEL=TETA*DT-DT 

SCAN  THE  FORCING  FUNCTION  MULTIPLIERS  FOR  ALL  DEGREES  OF  FREEDOM 


C 

C 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


C TO  ELIMINATE  THOSE  DOF*S  WHICH  ARE  UNLOADED.  ALSO  DELETE  THOSE 

C DOF*S  WHOSE  FUNCTIONS  ARRIVE  AFTER  THE  END  OF  THE  SOLUTION  PERIOD. 

C 

KLOAD  = 0 

00  30  K=1 ,NEQ 
B (K)  - 0.0 
DUM  - 0.0 
IDUM  - 0 

DO  20  1=1, NFN 

I F (I FF  (K, I) . GT.NT)  GO  TO  20 
I DUM  = I DUM  +1 
20  DUM  = DUM  +ABS  (FF (K, I) ) 

IF  (DUM.LT. 1 .OE-8)  GO  TO  30 
IF  ( I DUM.LT. 1)  GO  TO  30 

KLOAD  = KLOAD  +1 
LDOF (KLOAD)  = K 
30  CONTINUE 

1 F (KLOAD. GT.O)  GO  TO  40 
WRITE  (6,3000) 

3000  FORMAT  (32H0***  ERROR  SOLUTION  TERMINATED,  / 

1 13X.35HN0  FORCES  APPLIED  TO  THE  STRUCTURE.,  / IX) 

STOP 

40  CONTINUE 
C 

C GENERATE  SYSTEM  LOADS  AT  EACH  TIME  STEP 
C 

TT  = 0.0 
C 

DO  800  KK= 1 , NT 
C 

TT  = TT+DT 
C 

C CONSIDER  EACH  LOADED  DEGREE  OF  FREEDOM 
C 

DO  700  KD=1 .KLOAD 
KEQ  = LDOF  (KD) 

B(KEQ)  - 0.0 
C 

C CONSIDER  EACH  FORCING  FUNCTION  APPLIED  TO  THIS  DEGREE  OF  FREEDOM 
C 

DO  600  KF-l.NFN 
C 

C PASS  IF  ZERO  MULTIPLIER 
C 

IF  (ABS  (FF  (KEQ.KF))  .LT.  1 .OD-8)  GO  TO  600 
C 

C PASS  IF  THIS  FUNCTION  ARRIVES  LATER  THAN  CURRENT  TIME  STEP,  *KK* 

C 

I = IFF  (KEQ.KF)  -1 
I F (I .GT.KK)  GO  TO  600 
C 

C COMPUTE  RELATIVE  TIME  TO  BE  USED  FOR  FUNCTION  INTERPOLATION 
C 

TR  = TT  - FLOAT  (I  )*  DT 
C 
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C PASS  IF  THE  FINAL  TIME  POINT  IN  THIS  TABLE  IS  LESS  THAN  THE 
C RELATIVE  TIME 

C 

J = NLP(KF) 

TF  = P (2*K F — 1 ,J) 

I F (TF.LT.TR)  GO  TO  600 
C 

C INTERPOLATE  IN  THIS  TABLE  FOR  THE  VALUE  OF  FUNCTION  NUMBER  *KF* 

C AT  TIME  *TR+DEL* 

C 

NF2  = 2*KF 
NF1  = NF2-1 
C 

DO  500  L=2 , J 

IF  (TR.GT.P  (NF 1 , L) ) GO  TO  500 
RT  = P (NF  1 , L)  -P (NF 1 , L-  1) 

I F (RT.GT.  1 .OE-8)  GO  TO  1*90 
M * L-l 

WRITE  (6,3010)  M, L , KF 

3010  FORMAT  (53HO***  ERROR  ZERO  OR  NEGATIVE  TIME  DIFFERENCE  BETWEEN, 

1 9H  POINTS  (,I3,7H)  AND  (J3.1H),  / 1 3X,  8HFUNCT I ON , 

2 9H  NUMBER  (, I 3. 1H)  , / IX) 

STOP 

1*90  RF  = P (NF2.L)  -P  (NF2.L-1) 

C 

C EXTRAPOLATE  AN  AMOUNT  *DEL*  BEYOND  TIME  *TR* 

C 

FV  = P (NF2 , L-l)  + (TR-P  (NF 1 , L- 1 ) +DEL) * RF/  RT 
GO  TO  510 
500  CONTINUE 
C 

C COMPUTE  VALUE  OF  FORCE  (APPLIED  LOAD)  AT  THIS  TIME  STEP 
C 

510  B(KEQ)  = B(KEQ)  + FF(KEQ.KF)*  FV 
C 

600  CONTINUE 
700  CONTINUE 
C 

C SAVE  THE  LOAD  VECTOR  AT  THIS  STEP 
C 

WRITE  (KT)  B 
C 

800  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  LOAD  1 (ID.FF, I FF .NUMNP.NEQB.NFN) 

C 

C CALLED  BY?  H I STRY 

C 

DIMENSION  ID  (NUMNP , 6)  , FF  (NEQB.NFN) , IFF  (NEQB.NFN) 

COMMON  / JUNK  / NARB.NGM, I F I LL1 (428) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL2 (14) 

C 

C READ  ARBITRARY  DYNAMIC  LOADS 
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IF  (MODEX.EQ. 1)  GO  TO  11 
NT=2 

REWIND  NT 
REWIND  8 
READ  (8)  ID 
C 

NNN*NEQB*NFN 
DO  10  1*1, NNN 
IFF (I , 1 ) =0 

10  FF  (I , 1 ) *0 .ODO 
C 

11  WRITE  (6,2000) 

NARB* 1 

12  READ  (5.1000)  NP, 1C, IFN, IAT.P 
IF(IAT.EQ.O)  IAT-1 

I F (NP.GT.O)  GO  TO  15 

NARB*0 

RETURN 

15  WRITE  (6,2002)  NP, 1C, IFN, IAT.P 
IF  (MODEX.EQ. 1)  GO  TO  12 
C 

NS*  1 
NE=NEQB 

DO  500  NN= 1 , NUMNP 
DO  500  11=1,6 
C 

20  N*ID  (NN,  I I) 

IF  (N.LE.O)  GO  TO  300 
IF  (N.GE.NS)  GO  TO  50 
WRITE  (6,2001) 

STOP 

C 

50  IF  (N.LE.NE)  GO  TO  300 
C 

WRITE  (NT)  FF.IFF 
NS=NS+NEQB 
NE=NE+NEQB 
IFF  (I  , 1)=0 
100  FF  (I  , D-O.ODO 
C 

GO  TO  50 
C 

300  IF (NP.EQ.NN.AND. IC.EQ. I I)  GO  TO  350 
GO  TO  500 
350  M-N-NS+1 

IF  (N.LE.O)  GO  TO  400 
FF (M, I FN) *P 
IFF (M, I FN) ■ I AT 

400  READ  (5,1000)  NP, I C, I FN, I AT,P 
I F (I AT.EQ.O)  IAT-1 
WRITE (6,2002)  NP, 1C, IFN, IAT.P 
GO  TO  300 


500  CONTINUE 
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WRITE  (NT)  FF.IFF 
C 

RETURN 

C 

1000  FORMAT  (4I5.F10.2) 

2001  FORMAT  (18H0DATA  OUT  OF  ORDER  ) 

2000  FORMAT  (29H1DYNAMIC  NODAL  FORCES/MOMENTS,  //  14X.5HN0DAL, 7X, 

1 4HTIME.3X,7HARRIVAL,9X,4HTIME,/  3X,4HNODE,3X,9HDEGREE  0F.3X, 

2 8HFUNCTION,6X,4HTIME,5X,8HFUNCTION,/  7H  NUMBER, 5X,7HFREED0M,5X, 

3 6HNUMBER,4X,6HNUMBER,3X, 10HMULTI PL  I ER,  / IX) 

2002  FORMAT  (3X, I 4, 10X , I 2 ,8X, I 3. 7X, I 3. E 1 3- 4) 

C 

END 

SUBROUTINE  L0AD2  (F I , FF , I FF , PP ,T, P , PD , NEQB, NF ,NFN ,NT, MAX , 

NBLOCK , NAT) 

C 

C CALLED  BY?  h I STRY 
C 

COMMON  / EM  / AT  (1058) , I F I LL2  (3022) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL3 (14) 

DIMENSION  FI  (NEQB.NF)  , FF  (NEQB,NFN) .IFF  (NEQB.NFN)  , PP  (NFN , 1 ) ,T  (1)  , 
P ( 1 ) , PD  (NT) 

COMMON  / DYN  / I QT , NOT, DAMP , DT, I F I LL4  (6) 

COMMON  / JUNK  / NARB.NGM.HED  (12)  , I F I LL1  (404) 

COMMON  /one/  A ( 1 ) 
c***  COMMON  A (7 100) 

C 

C TRANSFORM  NODAL  TO  MODAL  LOADS 
C 

READ  (5,1002)  (AT  ( I ) , I * 1 , NAT) 

WRITE  (6,2004)  ( I , AT  ( I ) , I = 1 , NAT) 

I F (MODEX.EQ. 1)  GO  TO  302 
MT=4 

IF(NGM.EQ.O)  MT=2 
REWIND  MT 
NE=NAT*NF*NFN 
DO  10  1=1, NE 
10  A ( I ) =0 . 

KK=NF*NFN 

C 

DO  500  N= 1 .NBLOCK 
BACKSPACE  7 
•READ  (7)  FI 
BACKSPACE  7 
READ  (MT)  F F , IFF 
NN=-KK 
C 

DO  200  1=1 , NF 
DO  200  J=1 ,NFN 
NN-NN+1 

DO  200  L=1 , NEQB 
LL=I FF  (L , J) 

I F (LL.EQ.O)  GO  TO  200 
K=NN+LL*KK 

A (K)  =A  (K)  + FI  (L,  l)*FF  (L,J) 
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200  CONTINUE 
500  CONTINUE 
C 

C READ  TIME  FUNCTIONS  AND  GENERATE 

C EQUAL  INTERVAL  FUNCTIONS 

C 

TH-1 .k 

DTA=DT* (TH  - 1.) 

302  DO  335  1=1, NFN 
C 

READ  (5,1000)  NLP , SFTR, HED 
I F (SFTR.EQ.O.)  SFTR-1 .0 
WRITE  (6,2000)  I , HED, NLP, SFTR 
I F (NLP. LE .MAX)  GO  TO  305 
L-2*  (NLP-MAX) 

CALL  ERROR  (L) 

305  READ  (5,1001)  (T(L)  ,P(L)  ,L-1,NLP) 

WRITE  (6,2001)  (T  (L)  ,P(L)  , L-l.NLP) 

I F (MODEX.EQ. 1)  GO  TO  335 
C 

TIME-T(l) 

TIMEP-TIME  + DTA 

L=  1 

K-l 

310  L-L+l 

DDT-T  (L)  -T  (L-  1 ) 

DDP-P  (L) -P  (L-l) 

I F (DDT)  315,310,320 
315  WRITE  (6,2003) 

STOP 

320  SLOPE-DDP/DDT 
323  IF  (T(L)-TIME)  310,325,325 
325  PP(I  ,K)=P(L-1)  + (TIMEP  - T (L-l) ) *SLOPE 
PP  (I  ,K)-PP  (I  ,K)  *SFTR 
330  TIME-TIME+DT 

TIMEP-TIME  + DTA 
K-K+l 

IF  (NT-K)  335.323,323 
335  CONTINUE 

I F (MOOEX.EQ. 1)  RETURN 
C 

C GENERATE  MODAL  LOAD  VECTORS 
C 

MT-i» 

REWIND  MT 
LL-NF*NFN 
C 

DO  900  K-l , NF 
DO  550  l-l, NT 
550  PD  ( I ) *0 . 

I NC-  (K- 1) *NFN 
C 

DO  800  J-l.NAT 
LT-AT  (J) /DT  + 1 
N-0 
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C 

DO  600  NN=LT,NT 
N=N+1 

DO  600  1-1 ,NFN 
I l-INC+l 

600  PD  (NN)-PD  (NN)  + A <1  I)  *PP  (I  * N) 

C 

800  I NC= I NC+LL 
C 

900  WRITE  (MT)  PD 
C 

RETURN 

C 

1000  FORMAT  (I 5,F 10.0, 12A5) 

1001  FORMAT  (12F6.0) 

1002  FORMAT  (8F10.2) 

2000  FORMAT  (29H1TIME  FUNCTION  NUMBER  - (.I1*,  1H)  , // 

1 29H  FUNCTION  DESCRIPTION  = (,12A5,  1H) , // 

2 29H  NUMBER  OF  ABSCISSAE  - (.I1*.  1H)  , / 

3 29H  FUNCTION  SCALE  FACTOR  = (, E 1 3-4 . 1H)  , //  IX) 

2001  FORMAT  (5  (2X , 1 OHT I ME  VALUE  , 4X,  8HFUNCT I ON)  , / (5  (F  12. 5.  El  2.4)) ) 

2003  FORMAT  (38HO***  ERROR  TIME  POINTS  OUT  OF  ORDER.,  / IX) 

2004  FORMAT  (////  20H  ARRIVAL  TIME  VALUES,  //  7H  ENTRY , 3X , 7HARR I VAL , 

1 5H  TIME,  / 7H  NUMBER, 10X.5HVALUE , //  ( I 7 . F 1 5 - 6)  ) 

END 

SUBROUTINE  LOSTR  ( I S , A , B , SA , SF , L) 

C 

C CALLED  BY?  BRICK8 

D I MENS  ION  IS  (2)  ,A  (3,3)  .B  (3,3)  .SA  (12,24)  ,SF  (12,4)  , IRF  (6,2)  ,TC  (6,24) 
1 ,TR  (6,6) 

DATA  IRF  /I, 1,2, 2, 3. 3. 

1 2, 2, 3, 3. 1.1/ 

C 

LL-IS  (L) 
l-IRF  (LL, 1) 

TT-B  (1  , I)  *B  (1  , l)+B  (2,  I)  *B  (2,  l)+B  (3,  I)  *B  (3,  I) 

TT-SQRT (TT) 

TC  (3,  1)  =B  (1  , l)/TT 
TC (3,2)  “B (2, I) /TT 
TC (3.3) -B (3. I) /TT 
l-IRF  (LL , 2) 

TT— A ( I , 1)  *A  (I  , 1)+A  (I  ,2)  *A  (I  ,2)+A  (I  ,3)  *A  (I  ,3) 

TT-SQRT (TT) 

TC  (1 , 1)  -A  (I  , 1)  /TT 
TC  (1,2) -A  (1, 2)  /TT 
TC  (1 , 3)  “A  ( I ,3)  /TT 

TC  (2 , 1 ) -TC  (3 , 2)  *TC  (1 , 3)  'TC  (3 , 3)  *TC  (1 , 2) 

TC  (2 , 2)  -TC  (3 , 3)  *TC  ( 1 , 1 ) -TC  (3 , 1 ) *TC  ( 1 , 3) 

TC  (2,3)  =TC  (3,  1)  *TC  (1,2)  -TC  (3,2)  *TC  (1,1) 

C 

TR  (1 , 1)  -TC  (1,1)  *TC  (1,1) 

TR  (1  ,2)  -TC  (1,2)  *TC  (1 , 2) 

TR  ( 1 , 3)  -TC  (1,3)  *TC(1,3) 

TR  (1 ,4)  -TC  (1,1)  *TC  (1 ,2)  *2. 
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TR  (1 ,5)  =TC  (1,2)  *TC  ( 1 , 3)  *2  . 

TR(1,6)  -TC(1,1)*TC(1,3)*2. 

TR  (2,  1)  -TC  (2,  1)  *TC  (2,  1) 

TR  (2 , 2)  =TC  (2 , 2)  *TC  (2 , 2) 

TR  (2 , 3)  -TC(2,3)  *TC  (2 , 3) 

TR  (2,4)  =TC  (2,  1)  *TC  (2,2)  *2. 

TR  (2 , 5)  =TC  (2 , 2)  *TC  (2 , 3)  *2  . 

TR  (2 , 6)  =TC(2,  1)*TC(2,3)*2. 
TR(3,1)“TC(3,1)*TC(3.1) 

TR  (3,2) -TC  (3,2) *TC  (3,2) 

TR  (3,3)  *TC  (3,3)  *TC  (3,3) 

TR  (3 , 4)  -TC(3,1)*TC(3,2)*2. 

TR  (3 , 5)  =TC  (3 , 2)  *TC  (3, 3)  *2 . 

TR  (3,6) =TC  (3, 1) *TC  (3,3) *2. 

TR (4,1)  -TC (1,1) *TC  (2,1) 

TR  (4,2)  “TC  (1,2)  *TC  (2,2) 

TR  (4,3)  «TC(1,3)*TC(2,3) 

TR  (4 , 4)  =TC  (1 , 1)  *TC  (2 , 2)  +TC  (1,2)  *TC  (2,1) 
TR  (4 , 5)  -TC  ( 1 , 2)  *TC  (2 , 3)  +TC  ( 1 , 3)  *TC  (2 , 2) 
TR  (4,6)  -TC  (1,1)  *TC  (2 , 3)  +TC  ( 1 , 3)  *TC  (2,1) 
TR  (5,1)  =TC  (2, 1)  *TC  (3, 1) 

TR  (5,2)  =TC  (2,2)  *TC  (3,2) 

TR  (5,3)  =TC  (2 , 3)  *TC(3,3) 

TR  (5,4)  =TC  (2,  1)*TC  (3,2)+TC  (2,2)  *TC  (3,  1) 
TR  (5 . 5)  -TC  (2 . 2)  *TC  (3,3)  +TC  (2 , 3)  *TC  (3 , 2) 
TR  (5,6)  =TC  (2,  1)  *TC  (3,3)+TC  (2,3)  *TC  (3,1) 
TR  (6,1) -TC  (3,1) *TC  (1,1) 

TR  (6,2) -TC  (3,2)  *TC(1,2) 

TR  (6,3)  *TC  (3,3)  *TC  (1,3) 

TR  (6,4)  =TC  (3,  1)  *TC  (1 ,2)+TC  (3,2)  *TC  (1,1) 
TR  (6 , 5)  =TC  (3 , 2)  *TC  (1,3)  +TC  (3 , 3)  *TC  ( 1 , 2) 
TR  (6,6)  =TC  (3, 1)  *TC(1 ,3)+TC  (3,3)  *TC  (1 , 1) 
C 

I L= (L- 1 ) *6 
DO  100  1-1,6 
DO  100  J=1 ,24 
TC  (I  ,J)-0. 

DO  100  K= 1 ,6 

100  TC  (I  ,J)=TC(I  , J)  +TR  ( I , K)  *SA  ( I L+K , J) 

DO  110  1-1,6 
DO  110  J— 1 ,24 
110  SA ( I L+ 1 , J) -TC  ( I ,J) 

C 

DO  120  1-1,6 
DO  120  J-1,4 
TC  ( I , J) -0 . 

DO  120  K-1,6 

120  TC  (I  , J)  -TC  (I  , J)  +TR  ( I , K)  *SF  ( I L+K , J) 

DO  130  1=1,6 
DO  130  J-1,4 
130  SF ( I L+l , J) -TC  ( I , J) 


C 


RETURN 

END 
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C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


CALLED  BY?  QTSHEL 

THIS  SUBROUTINE  COMPUTES  THE  IN-PLANE  STRESSES  IN  A LINEAR  STRAIN 
TRIANGLE  (LST)  WITH  6,  5 OR  4 NODAL  POINTS,  OR  IN  A CONSTANT 
STRAIN  TRIANGLE  (CST) 


***************  INPUTS  **************** 
M, A , B , C AS  IN  SLST . 

U ( I ) . v (I ) 1*1... 3+M  IN-PLANE  NODAL  DISPLACEMENT  COMPONENTS.  THE 

MIDPOINT  VALUES  U ( I ) , V ( I ) , I =4 . . . 3+M,  IF  ANY,  ARE 
DEVIATIONS  FROM  LINEARITY 

**************  OUTPUTS  **************** 

Smt  ( I J)  1=1... 3,  J-1...3  MEMBRANE  STRESS  COMPONENTS  SIG-XX 
(j=l) , SIG-YY  (J=2) , AND  S I G-XY  (J=3)  AT  THE  CORNERS 
1-1. ..3,  ASSOCIATED  WITH  THE  INPUT  DISPLACEMENTS 


SUBROUTINE  LSTSTR  (M) 

COMMON  /TRIARG/  A (3)  . B (3)  • H (3)  .HPT  (3)  . C (3 , 3)  . SMT  (3,3)  > 

1 BMT  (3 , 3)  , U (6)  ,V(6)  , W (3)  ,RX(3)  ,RY(3)  .RM(3)  . ST  (12, 12) 
DIMENSION  EXX  (3)  . EYY  (3)  , GXY  (3)  , EPS  (3  > 3)  « I PERM  (3) 
EQUIVALENCE  (EXX  (1)  , EPS  (1) ) , (EYY  (1)  , EPS  (4) ) , (GXY  (1)  , EPS  (7) ) 
DATA  IPERM  /2.3J/ 

AREA  = A (3)  *B  (2) -A  (2)  *B  (3) 

Ell  = (B(1)*U(1)+B(2)*U(2)+B(3)*U(3))/AREA 

E22  = (A  ( 1 ) *V  (1 ) +A  (2)  *V  (2)  + A (3)  *V  (3) ) / AREA 

G 1 2 = (A(1)*U(1)+A(2)*U(2)+A(3)*U(3)+B(0*V(1)+B(2)*V(2) 

1 +B  (3)  *V  (3) ) / AREA 


DO  150  1=1,3 
EXX ( I ) = Ell 
EYY ( I ) = E22 
150  GXY  (I)  = G12 

IF  (M.LE.O)  GO  TO  250 
DO  200  1=1, M 
X = 4.0*U  (1+3) /AREA 
Y = 4.0*V  (1+3) /AREA 
J = I PERM  (I) 

K = I PERM  (J) 

EXX  (J)  = EXX  (J)  + B(K)*X 
EXX  (K)  = EXX  (K)  + B(J)*X 
EYY  (J)  = EYY  (J)  + A (K)  *Y 

EYY  (K)  = EYY  (K)  + A (J)  *Y 

GXY  (J)  = GXY  (J)  + A (K)  *X  + B (K)  *Y 

200  GXY  (K)  = GXY  (K)  + A (J)  *X  + B (J)  *Y 

250  DO  300  1=1,3 

300  Srftjri’  C (J  . 1 ) *EPS  ( I , 1)  +C  (J , 2)  *EPS  ( I , 2)  +C  (J , 3)  *EPS  (1,3) 
RETURN 
END 

SUBROUTINE  MODES  (NEQ,MBAND,NBLOCK,NEQB,NF ,MTOT, I FPR, I FSS.RTOL, 
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1NITEM.COFQ) 

C 

C CALLS?  SECNTD , SB LOCK , SSPCEB 

C CALLED  BY?  SOLEIG 

C 

C PROGRAM  TO  COMPUTE  SMALLEST  EIGENVALUES  AND  ASSOCIATED  VECTORS  IN 
C THE  GENERALIZED  EIGENVALUE  PROBLEM 

C A*V=RT*B*V  (A  POS  DEF  ,B  D I AG  NONNEG  DEF) 

C 

C 

COMMON  /SOL/  IDUM(5)  , NE I G , NAD , NVV, ANORM.NFO 
COMMON  /TAPES/NST I F , NRED , NL , NR , NT, NMASS 
COMMON  /one/  A ( 1 ) 
c***  COMMON  A (7100) 

C 

C 

NST I F=4 
NMASS-9 
NRED=1 0 
NL=2 
NR=3 
NT=7 
C 

C PRINT  E I GENPROBLEM  SUMMARY 

C 

WRITE  (6,1000)  NEQ, MBAND , NBLOCK.NEQB.NF 
C 

I F (NE IG.GT.O)  GO  TO  300 
C 

C DETERMINANT  SEARCH 

C 

IF  (NVV.GE.NF)  GO  TO  110 
WRITE  (6,1010)  NF.NVV 
STOP 

1 10  CONTINUE 
N I M=3 
NVM=6 
NC-NF+NIM 

NCA=NEQ*MAXO  (MBAND, NC) 

N2=1+NCA 
N3-N2+NEQ 
N4=N3+NEQ 
N5-N4+NEQ 
N6-N5+NEQ 
N7-N6+NEQ*NVM 
N8-N7+NEQ*NVM 
N9-N8+NC 
N10-N9+NC 
N 1 1 =N 1 O+NC 
N 1 2=N 1 1+NC 
C 

200  CALL  SECNTD  (A  ( 1 ) , A (N2)  , A (N3)  , A (Nit)  , A (N5)  , A (N6)  , A (N7)  . A (N8)  , A (N9 
1) , A (N 10) , A (N 1 1 ) , A (N 1 2) , NEQ, MBAND, NF ,NC, I FPR, ANORM, COFQ) 

GO  TO  600 
C 
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C SUBSPACE  ITERATION 

C 

300  NWA=NEQB*MBAND 
NV=2*NF 

IF  (NF.GT.8)  nv=nf+8 
IF  (NAD.NE.O)  NV-NAD 
IF  (NVV.GE.NV)  GO  TO  310 
WRITE  (6,1010)  NV.NVV 
STOP 

310  NWV=NV*NEQB 

NTB=  (MBAND-2) /NEQB+1 
IF  (NTB.GE.NBLOCK)  NTB=NBLOCK- 1 
NWVV-NWV*  (NTB+1) 

C 

C CHECK  FOR  USE  OF  GIVEN  STARTING  ITERATION  VECTORS 
C 

IF  (NFO.LE.O)  GO  TO  500 
REWIND  10 

READ  (10)  NEQ0,N8L0K0,NEQB0,MBAND0,N10,NF0 

N2=1+NEQB0*NF0 

N3=N2+NEQB*NV 

L CALL  SBLOCK  (A(l)  ,A(N2)  ,A(N3)  ,NFO,NV,NEQBO,NEQB,NBLOKO,NBLOCK) 

C500  CALL  SSPCEB  (NEQ,MBAND,NBLOCK,NEQB,NF ,NV,NWA,NWV,NWVV,NTB, I FPR, 

1 I FSS , N I TEM, RTOL , ANORM, COF  Q) 

C 

600  RETURN 
C 

1000  FORMAT  (////  46H  SOLUTION  IS  SOUGHT  FOR  FOLLOWING  E I GENPROBLEM, // 


1 / 37H  NUMBER  OF  EQUATIONS  =J5  // 

2 37H  HALF  BANDWIDTH  OF  STIFFNESS  MATRIX  =,15  // 

3 37H  NUMBER  OF  EQUATION  BLOCKS  =J5  // 

4 37H  NUMBER  OF  EQUATIONS  PER  BLOCK  = J5  // 

5 37H  NUMBER  OF  EIGENVALUES  REQUIRED  =, 1 5 //  ) 

1010  FORMAT  (///  32HO***ERROR  SOLUTION  TERMINATED.,  / 

1 1 2X , 40HNUMBER  OF  NON-ZERO  MASSES  REQUIRED  15  / 


2 1 2X , 40HNUMBER  OF  EXISTING  MASSES  IN  THE  MODEL  =,  15  ) 

C 

END 

SUBROUTINE  MULT  (W, A.V.NN.MA) 

C CALLED  BY  ? SECNTD 

C 

C 

DIMENSION  A (1)  ,W(1)  ,V(1) 

NM=NN*(MA  -1) 

NMA=NN  - MA  + 1 
DO  20  1-1, NN 
W(l)=0.0 
K-l  - 1 

IF  (NMA  -I)  10,15.15 
10  NM-NM  - NN 
15  IL-NM  + 1 

DO  20  J-l , I L , NN 


C 
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K=K  + 1 

20  W ( I ) =W  ( I ) + A (J)  *V  (K) 

C 

IF  (MA  -1)  30,100,30 
C 

30  KK=NN 

DO  1*0  I-2.MA 
11=1  -1 
KK=KK  + NN 
KJ=KK 

DO  40  J=1 , I I 
KJ=KJ  -NN 

40  W ( I ) =W  ( I ) + A (KJ  + J)  *V(J) 

IF  (MA.EQ.NN)  GO  TO  100 
MA1=MA  + 1 
I J=1 

DO  50  I -MA 1 , NN 
KJ=KK 
I J= I J + 1 
11=1  -1 
DO  50  J=l J, I I 
K J=K J - NN 

50  W ( I ) =W  ( I ) + A (KJ  + J)  *V  (J) 

C 

100  RETURN 
END 

SUBROUTINE  PINVER  (A , NMAX , ND , NODE , NEL , MODEX) 

C 

C CALLED  BY?  TANGKS , BENDKS 
C 

C INVERSION  OF  A POSITIVE  DEFINITE  MATRIX 
C 

DIMENSION  A (ND , ND) 

C 

DO  200  N-l.NMAX 
C 

IF  (ABS  (A  (N , N) ) .GT.  1 .00-20)  GO  TO  50 
WRITE  (6,2000)  N, NODE, NEL 

2000  FORMAT  (19H0***  ERROR.  ROW  (.I2.27H)  OF  THE  FLEXIBILITY  MATRIX, 

1 10H  AT  NODE  (,I4,20H)  FOR  PIPE  ELEMENT  (,I4,14H)  IS  SINGULAR.,  / 

2 IX  ) 

MODEX  = 1 
RETURN 

C 

50  D = 1.0/  A (N,N) 

DO  100  J-l.NMAX 
100  A (N , J)  = -A  (N , J)  * D 
C 

DO  150  1=1, NMAX 

I F (N.EQ. I)  GO  TO  150 

DO  140  J=1 ,NMAX 

IF  (N.EQ. J)  GO  TO  140 

A (I  ,J)  = A (I  ,J)  + A (I  ,N)*A(N,J) 

140  CONTINUE 

150  A ( I , N)  = A ( I , N)  * D 
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C 

C 


A (N , N)  = D 
200  CONTINUE 


C 

RETURN 

END 

SUBROUTINE  PIPE 
C 

C CALLS?  P I PEK , STRSC 

C CALLED  BY?  ELTYPE 

C 

C CONTROL  ROUTINE  FOR  PIPE  ELEMENT  STIFFNESS/LOAD  FORMATION  AND 

C STRESS  RECOVERY 

C 

COMMON  /ELPAR/  NPAR  ( 1 4)  , NUMNP , MBAND .NELTYP, N 1 , N2 , N3 . N4 , N5.MT0T.NEQ 
COMMON  /JUNK/  LT , LH , L , I PAD  1 , S I G ( 1 8) , N6 ,N7 »N8,N9, N 10 , N 1 1 , N 1 2 , N 1 3 > 

1 Nl4,N15»Nl6,N17*Nl8, I PAD2 , DUMMY (1 88) 

COMMON  /EM/  NS, I F I LL  (5137) 

COMMON  /EXTRA/  M0DEX,NT8,N10SV,NT10, I F I LL2 (12) 

common  /say/  neqq , numee , 1 oopur , nnb 1 ock , nterms , opt i on 
common  /what/  naxa  (10000) , i rowl  (10000) , icolh  (10000) 

C 

DATA  HI/1HI/.HC/1HC/.HJ/1HJ/ 

C 

COMMON  /one/  A (1) 

C 

IF  (NPAR  ( 1 ) . EQ.O)  GO  TO  500 
C 

C FORM  ELEMENT  STIFFNESS,  LOAD  AND  STRESS  TRANSFORMATION  MATRICES 
C 

C 1 . ERROR  CHECKS 

C 

WRITE  (6,2000) 

IF  (NPAR  (2)  .GT.O)  GO  TO  10 
WRITE  (6,3000)  (NPAR(K)  ,K=1  ,7) 

WRITE  (6,3010) 

STOP 

10  I F (NPAR  (3)  .GT.O)  GO  TO  20 

WRITE  (6,3000)  (NPAR  (K) ,K»1 ,7) 

WRITE  (6,3020) 

STOP 

20  IF  (NPAR  (4)  . LT . 1 ) NPAR  (4)  = 1 
IF  (NPAR  (5)  .GT.O)  GO  TO  30 
WRITE  (6,3000)  (NPAR(K)  ,K«1 ,7) 

WRITE  (6,3030) 

STOP 

30  I F (NPAR  (6)  . LT . 1 ) NPAR  (6)  -0 
IF  (NPAR  (7)  . LT . 3)  NPAR  (7)  * 4 
C 

C 2.  STORAGE  ALLOCATION 

C 

N6  = N5  + NUMNP 
KK  = NPAR  (4)*  NPAR  (3) 

N7  = N6  + KK 


FILE:  PSAP 


FRC 


A 


OLD  DOMINION  UNIVERSITY 


N8  = N7  + KK 
N9  = N8  + KK 
N 1 0=  N9  + KK 
Nil-  N10+  NPAR  (5) 

N 1 2-  N11+  NPAR  (5) 

N 1 3=  N12+  NPAR  (5) 

N 1 4-  N13+  NPAR  (5) 

N15-  N14+  NPAR  (5) 

N16-  N15+  NPAR  (5) 

N 1 7=  N 16+  NPAR  (5) 

N 1 8=  N17+  NPAR  (6) 

N 1 9=  N 1 8+  NPAR  (6) *NPAR  (7) 

C 

IF  (N 1 9 • GT . MTOT)  CALL  ERROR  (N19-MT0T) 

C 

C DUMP  FLAGS  (GT.O,  DUMP) 

C 

C NPAR  (9)  = 

C NPAR  (10)  = 

C NPAR  (11)  = 

C NPAR  ( 1 2)  = 

C NPAR  ( 1 3)  = 

C 

C NPAR  ( 1 4)  = 

C 

c 
c 

CALL  PIPEK  (NPAR  (2) .NPAR  (3) , NPAR  (4)  .NPAR (5) .NPAR  (6) , NPAR  (7) , 

1 A (N 1)  , A (N2)  ,A(N3)  ,A(N4)  ,A(N5)  ,A(N6)  ,A(N7)  ,A(N8)  , 

2 A(N9)  , A (N 1 0)  , A (N 1 1 ) , A (N 1 2)  , A (N 1 3)  , A (N 1 4)  , A (N  1 5)  . 

3 A (N 16)  , A (N 1 7)  , A (N 1 8)  .NUMNP.MBAND) 

C 

RETURN 

C 

C COMPUTE  ELEMENT  STRESS  OUTPUT 

C 

500  CONTINUE 

WRITE  (6,4000) 

LINE  - 5 
NUMEL  - NPAR  (2) 

C 

DO  800  MM- 1, NUMEL 
C 

CALL  STRSC  (A  (Nl)  , A (N3) .NEQ.O) 

C***  STRESS  PORTHOLE 
IF (N10SV.EQ. 1) 

*WR I TE  (NT  10)  NS 
DO  700  L-LT.LH 

CALL  STRSC  (A  (Nl)  , A (N3)  ,NEQ,  1) 

IF (LINE. LE. 55)  GO  TO  510 
WRITE  (6,4000) 

LINE  * 5 

510  I F (NS.GT. 12)  GO  TO  520 

WRITE  (6,4010)  MM, L,  (SIG(I)  , 1-1,12) 


TANGENT  ELEMENT  MATRICES 
BEND  ELEMENT  MATRICES 
ELEMENT  PROPERTIES 
NOT  USED 

LOAD  CASE  NUMBER  FOR  WHICH  ELEMENT  FORCES  ARE  TO 
BE  SAVED  ON  PUNCH  CARDS 

5 DIGIT  IDENTIFIER  PUNCHED  ON  EACH  ELEMENT  FORCE  CARD 
(APPEARS  IN  CC  76-80  ON  EVERY  CARD  OUTPUT) 


C 
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LINE  = LINE  +3 
C***  STRESS  PORTHOLE 
I F (N10SV.EQ. 1) 

*WRITE  (NT1 0)  MM, L, (SIG  (I) , 1-1,12) 

IF  (NPAR03)  .NE.L)  GO  TO  700 

C SAVE  TANGENT  FORCES/MOMENTS  (l,J)  FOR  THIS  LOAD  CASE  ON  PUNCH 

C WRITE  (11,5000)  MM,  (SIG  (I)  , 1 = 1 ,6)  ,HI  ,L,NPAR(l4) 

C WRITE  (11,5000)  MM,  (SIG(I)  ,1=7,12)  ,HJ,L,NPAR(l4) 

GO  TO  700 
520  CONTINUE 

WRITE  (6,4020)  MM , L , (S I G ( I ) , I = 1 , 1 8) 

LINE  = LINE  +4 
C***  STRESS  PORTHOLE 
I F (N10SV.EQ. 1) 

ftWRITE  (NT10)  MM,L,  (SIG  (I) , 1=1 , 18) 

IF  (NPAR  (1  3)  -NE.L)  GO  TO  700 

C SAVE  BEND  FORCES/MOMENTS  (C,J)  FOR  THIS  LOAD  CASE  ON  PUNCH 

C WRITE  (11,5000)  MM,  (SIG  (I)  , 1=7, 12)  ,HC,L,NPAR(14) 

C WRITE  (11,5000)  MM,  (SIG  (I) , 1*13, 18)  ,HJ,L,NPAR(14) 

C 

700  CONTINUE 
800  CONTINUE 
C 

RETURN 

c 

2000  FORMAT  (46H1P  IPE  ELEMENT  INPUT  DATA,  /// 

1  38H  C 0 N T R 0 L I N F 0 R M A T I 0 N,  //  IX) 

C 

3000  FORMAT  ( 1 6 3H  ERROR  DETECTED  WHILE  PROCESSING  MASTER  ELEMENT 
1 CONTROL  CARD.',  //  16X, 1H  (.7 1 5. 1H)  , / IX) 

3010  FORMAT  (16X.26HN0  PIPE  ELEMENTS  SPECIFIED,  / IX) 

3020  FORMAT  (16X.22HN0  MATERIALS  REQUESTED,  / IX) 

3030  FORMAT  (16X.31HN0  SECTION  PROPERTIES  REQUESTED,  / IX) 

C 

4000  FORMAT  (46H1P  IPE  FORCES  AND  MOMENTS,// 

1 8H  ELEMENT, 2X,7HELEMENT,3X,4HL0AD,2X,7HSTATI0N,8X,5HAXIAL,7X, 

2 6HY-AX I S , 7X, 6HZ-AX I S , 4X,  9HT0RS I ONAL , 7X .6HY-AX I S, 7X , 6HZ-AX I S , / 

3 2X,6HNUMBER.5X,4HTYPE,3X,4HCASE,17X,5HFORCE,  2 (8X.5HSHEAR)  , 

4 3(7X,6HMOMENT)  , / IX) 

4010  FORMAT  (4X , I 4, 2X , 7HTANGENT, 4X , I 3 , 4X,  5HEND- 1 , 3F  1 3 • 3, 3F  1 3 • 2 / 28X, 
1 5HEND-J .3F13-3.3F13-2  / IX) 

4020  FORMAT  (4X , I 4 , 5X , 4HBEND , 4X , I 3 , 4X , 5HEND- I , 3F 1 3 • 3, 3F 1 3 • 2 / 27X. 

1 6HCENTER.3F 1 3*3, 3? 1 3-2  / 28X , 5HEND-J , 3F 1 3- 3. 3F 1 3 . 2 / IX) 

C 

5000  FORMAT  (3X, I 3.4X.6E10.3.A1 , I2.2X, 15) 

C 

END 

C CALLS?  PI PES2, TANGDC.SE LECT, TANGKS.BENDDC.PI PES3.BENDKS.CALBAN 

C CALLED  BY?  PIPE 

c 

C FORMATION  OF  3-D  PIPE  TANGENT  AND  BEND  ELEMENT  STIFFNESS,  LOAD 
C AND  STRESS  TRANSFORMATION  ARRAYS 

C 
C 
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= NUMBER  OF  PIPE  ELEMENTS 
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NUMMAT 

- 

NUMBER  OF  MATERIALS 

C 

MAXTP 

a 

MAXIMUM  NUMBER  OF  TEMPERATURE  POINTS  DESCRIBING 

c 

ANY  ONE  MATERIAL 

c 

NPROP 

s 

NUMBER  OF  SECTION  PROPERTY  SETS 

c 

NBPN 

s 

NUMBER  OF  BRANCH  POINT  NODES 

c 

MAXTAN 

= 

MAXIMUM  NUMBER  OF  TANGENT  ELEMENTS  COMMON  TO  A 

c 

BRANCH  POINT  NODE 

c 

ID 

= 

MASTER  INDEX  ARRAY 

c 

X,Y,Z 

= 

NODE  COORDINATES 

c 

T 

s 

NODE  TEMPERATURES 

c 

TM 

= 

MATERIAL  TEMPERATURE  ARRAY 

c 

E 

= 

YOUNG*S  MODULUS  TABLE 

c 

XNU 

= 

POISSON*S  RATIO  TABLE 

c 

ALP 

= 

THERMAL  EXPANSION  COEFFICIENTS  TABLE 

c 

DOUT 

= 

OUTSIDE  DIAMETER  OF  THE  PIPE  SECTION 

c 

WALL 

= 

PIPE  WALL  THICKNESS 

c 

ALFAV 

a 

SHEAR  SHAPE  FACTOR 

c 

XWGT 

s 

SECTION  WEIGHT  PER  UNIT  LENGTH 

c 

XMAS 

= 

SECTION  MASS  PER  UNIT  LENGTH 

c 

AREA 

= 

AREA  OF  THE  PIPE  CROSS  SECTION 

c 

XMI 

a 

SECTION  MOMENT  OF  INERTIA 

c 

NODBR 

= 

BRANCH  POINT  NODE  ARRAY 

c 

NEBR 

s 

ARRAY  CONTAINING  TANGENT  ELEMENT  NUMBERS  COMMON 

c 

TO  THE  BRANCH  NODE.  POSITIVE  ELEMENT  NUMBERS  ARE 

c 

ATTACHED  TO  THE  BRANCH  AT  THEIR  1 -TH  END. 

c 

NUMNP 

NUMBER  OF  NODES 

c 

MBAND 

= 

EQUATION  BANDWIDTH 

c 

S 

= 

ELEMENT  STIFFNESS  MATRIX 

c 

LM 

= 

ELEMENT  EQUATION  NUMBER  ARRAY 

c 

RF 

= 

GLOBAL  LOADS  FOR  EACH  ELEMENT  LOAD  CASE 

c 

XM 

a 

ELEMENT  LUMPED  MASS  MATRIX 

c 

SA 

= 

STRESS  DISPLACEMENT  TRANSFORMATION  MATRIX 

c 

SF 

* 

RESTRAINED  NODE  CORRECTIONS  FOR  EACH  ELEMENT 

c 

r 

LOAD  CASE  (A,  B,  C,  OR  D) 

SUBROUTINE  PI 

PE  K (NP 1 PE , NUMMAT , MAXTP .NPROP , NBPN , MAXTAN , 

1 

1 D,X, Y,Z,T ,TM, E, 

2 

XNU, ALP, DOUT, WALL, ALFAV, XWGT, XMAS, 

3 

AREA, XMI , NODBR, NEBR, NUMNP, MBAND) 

COMMON 

/PI  PEC/ 

SHE AR.YM.POS, PARA  1 .PARA2.N0AX, NODE, NELEMT.MODEX, 

1 

PARA3, THERM, PRESS, SECTA, SECT  1 , SECTW, SECTD , SECTM 

COMMON 

/EM/ 

LM  (1  2)  ,ND,NS,S(12,12)  ,RF  (12,4)  ,XM(12)  ,SA  (18,  12)  , 

1 

SF  (18,4)  , FEF  (12,5)  , FEFC  (18,5)  .FLEX  (6,6)  ,BT(6,6)  , 

2 

HT  (6,6)  , DC  (3,3)  , IFILL3(3606) 

COMMON 

/JUNK/ 

TITLE  (8)  , DC  1 (3,3)  * X 1 P (3)  ,X2P(3)  ,X3P  (3)  ,EMUL(5,4)  , 

1 

HD  (6)  , Q (3, 3)  ,QQ(3,3)  .FAC  (5)  .AC  (3)  ,KB(2)  .HEDBR  (8)  , 

2 

IFILL1  (256) 

COMMON 

/ELPAR/ 

NPAR  ( 1 4)  , 1 F 1 LL2  (10) 

COMMON 

/EXTRA/ 

KODEX ,NT8, 1 F 1 LL4  (14) 

common 

/say/ 

neqq , numee, 1 oopur , nnb 1 ock , n terms , opt i on 

c 

common 

/what/ 

naxa (lOOOO) , irowl  (10000) , icolh  (10000) 

DIMENSION 

ID  (NUMNP,  1)  ,X  (1)  , Y (1)  ,Z  (1)  ,T(1)  ,TM  (MAXTP,  1)  , 

1 

E (MAXTP,  1)  , XNU  (MAXTP,  1)  , ALP  (MAXTP,  1)  ,D0UT(1)  , 

2 

WALL  ( 1 ) , ALFAV  (1)  ,XWGT(1)  ,XMAS(1)  .AREA  (1)  , XMI  (1)  , 
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3 NODBR  (1)  , NEBR  (NBPN , 1 ) 

C 

DIMENSION  HED 1 (2,2) 

C 

DATA  HED1  /6HTANGEN , 6HBEND  , 1HT.1H  / 

DATA  HD1.HD2.HD3/5H  NONE , 5H  AT  I ,5H  AT  J/ 

DATA  TGI ,TG2,TG3,TG4,TG5/'BI , ' I ' , ' '.'C'.'CC'/ 

C 

c INITIALIZATION 

C 

WRITE  (6,2000)  NP I PE , NUMMAT, MAXTP , NPROP , NBPN , MAXTAN 
NOAX  = 0 

IF  (NPAR(8)  . LT.  1)  GO  TO  5 
NOAX  = 1 

5 WRITE  (6,2005)  NOAX 
MODEX  = KODEX 
P I = 4.0D0*ATAN  (1 .ODO) 

ND  = 12 
C 

C READ  AND  PRINT  MATERIAL  PROPERTY  DATA 
C 

WRITE  (6,2010) 

DO  45  K=l, NUMMAT 
READ  (5,1000)  N.NT.HD 
IF  (NT.LT.l)  NT  = 1 
WRITE  (6,2020)  N.NT.HD 
I F (N.LE. NUMMAT)  GO  TO  10 
WRITE  (6,3000) 

STOP 

10  I F (N.GT.O)  GO  TO  15 
WRITE  (6,3010) 

STOP 

15  IF  (NT. LE. MAXTP)  GO  TO  20 
WRITE  (6,3020)  MAXTP 
STOP 

20  CONTINUE 

IF  (MAXTP.LT. 2)  GO  TO  30 
DO  25  L=2, MAXTP 
25  TM  (L , N)  = 0.0 
30  CONTINUE 

DO  40  1-1, NT 

READ  (5,1005)  TM  ( I , N)  , E (I  , N)  , XNU  (I  , N)  , ALP  (I  ,N) 
WRITE  (6,2030)  I ,TM  ( I , N) , E ( I , N)  , XNU  ( I ,N) , ALP  (I ,N) 

IF  (I  . LT. 2)  GO  TO  40 

IF  (TM  (I  , N)  .GT.TM(l-l.N))  GO  TO  40 

WRITE  (6,3030) 

STOP 

40  CONTINUE 

I F (NT. LT. MAXTP)  TM  (NT+1 , N)  - -10000.0 
45  CONTINUE 

C***  DATA  PORTHOLE  SAVE 

IF  (MODEX. EQ.l)  , % 

1 WRITE  (NT8)  ((TM(I,K)  ,E(I,K)  ,XNU(I  ,K)  .ALP(I.K)  ,1-1 

2 K-l, NUMMAT) 


.MAXTP)  , 
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C READ  AND  PRINT  SECTION  PROPERTY  DATA 
C 

WRITE  (6,2040) 

DO  70  K*1 , NPROP 

READ  (5,1010)  N,X1,X2,X3,X4,X5,  (HD(J) ,J=1,3) 

I F (X5-LT. 1 .0E-12)  X5  = X4/  386.4 

WRITE  (6,2050)  N,X1,X2,X3,X4,X5,  (HD(J) ,J=1,3) 

I F (N.GT.O  .AND.  N.LE. NPROP)  GO  TO  50 

WRITE  (6,3040)  N 

STOP 

50  DOUT(N)  - XI 
WALL  (N)  = X2 

ALFAV(N)  = X3 
XWGT(N)  = X4 
XMAS  (N)  = X5 

IF  (DOUT(N)  .GT.l.OE-8)  GO  TO  55 

WRITE  (6,3050)  N 

STOP 

55  IF  (WALL  (N)  .GT.l.OE-8)  GO  TO  60 
WRITE  (6,3060)  N 
STOP 
C 

C COMPUTE  SECTION  PROPERTIES 
C 

60  CALL  PIPES2  (X1,X2,X3,X4,X5,PI) 

AREA  (N)  = X4 
XMI  (N)  * X5 

IF  (ALFAV(N)  .LT.l.OE-8)  ALFAV(N)  =X3 
70  CONTINUE 

C*ft*  DATA  PORTHOLE  SAVE 
I F (MODEX.EQ. 1) 

1WRITE  (NT8)  (DOUT(N)  .WALL  (N)  ,ALFAV(N)  ,XWGT(N)  .XMAS  (N)  .AREA  (N)  , 
2 XMI  (N) ,N=1 .NPROP) 

C 

C READ  AND  PRINT  BRANCH  POINT  NODES 
C 

IF  (NBPN.LT. 1)  GO  TO  90 
WRITE  (6,2060) 

WRITE  (6,2070) 

READ  (5,1020)  (NODBR  (K) ,K=1 ,NBPN) 

WRITE  (6,2080)  (K, NODBR  (K) ,K*1 ,NBPN) 

C 

C TEST  FOR  ADMISSIBLE  NODE  NUMBERS 
C 

DO  80  L-l ,NBPN 

I F (NODBR  (L)  .GT.O  .AND.  NODBR  (L)  . LE .NUMNP)  GO  TO  80 

WRITE  (6,3070)  L 

STOP 

80  CONTINUE 

C***  DATA  PORTHOLE  SAVE 
I F (MODEX.EQ. 1) 

*WRITE  (NT8)  (NODBR  (N) ,N*1 ,NBPN) 


C*** 
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C 

DO  85  1=1 , NBPN 
DO  85  L=1 , MAXTAN 
NEBR  (I  ,L)  = 0 
85  CONTINUE 
C 

90  CONTINUE 
C 

C READ  AND  PRINT  ELEMENT  LOAD  CASE  MULTIPLIERS 
C 

WRITE  (6,2090) 

READ  (5,1030)  ( (EMUL  (I  , J)  , J=1 ,4)  , 1 = 1 ,5) 

WRITE  (6,2100)  ( (EMUL  (I  , J)  , J=1  ,4)  , 1 = 1 ,5) 

C***  DATA  PORTHOLE  SAVE 
I F (MODEX.EQ. 1) 

ftWRITE  (NT8)  ((EMUL  (I  ,J)  , 1=1  ,5)  ,J=1.4) 

C*** 

c 

C READ  AND  PRINT  ELEMENT  DATA 

C PERFORM  GENERATION  FOR  TANGENT  ELEMENTS  MISSING  IN  SEQUENCE 
C 

WRITE  (6,2110) 

LINE  = 7 
XLN 1 = 0.0 
TR1  =0.0 
PR  1 =0.0 

TAVG 1=  0.0 
MAT  1 =0 
IS1  =0 
DO  95  1*1.2 
DO  95  J=1 .2 
95  DC1  (I , J)  =0.0 
NEL  = 0 
L = 0 

100  KG  = 0 , 

READ  (5,1040)  INEL.Xl , INI , INJ, IMAT, ISP.TRI ,PRI ,X2,X3,X4, INC 

I TYP  = 1 

IF  (XI .EQ.TG1)  I TYP  = 2 
XT AG  = TG2 
C 

C BRANCH  DEPENDING  ON  ELEMENT  TYPE 

C 

GO  TO  (1 10,300) , I TYP 
C 

C TANGENT  ELEMENT 

C 

110  IF  (INC.EQ.O)  INC  = 1 
115  L = L+l 
KG  = KG  +1 
ML  = INEL-L 
IF  (ML)  120,125,130 
120  WRITE  (6,3080)  I NEL 
STOP 

125  NEL  = INEL 
N I = INI 
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NJ  = INJ 
MAT  = I MAT 
IS  = ISP 
TR  - TRI 
PR  = PR  I 
AC  (1)  - X2 
AC  (2)  * X3 
AC (3)  - X4 
INK  = INC 
GO  TO  135 
130  NEL  = INEL-ML 
INK  * 0 
XTAG  - TG3 
N I = IN  + KG*  I NCR 
NJ  = JN  + KG*  I NCR 
135  CONTINUE 

IF  (LINE. LT. 57)  GO  TO  140 
WRITE  (6,2110) 

LINE  = 7 
140  CONTINUE 

WRITE  (6,2120)  NEL.HED1  (1 , 1) ,HED1  (1 ,2) ,NI ,NJ,MAT, IS,TR,PR,X2,X3, 
1 X4, INK, XTAG, XTAG 

LINE  = LINE  +1 
C***  DATA  PORTHOLE  SAVE 
IF  (MODEX.EQ. 1) 

*WR I TE  (NT8)  NEL, ITYP.NI ,NJ,MAT, IS.TR.PR 

c*** 

c 

C TEST  DATA  INPUT  FOR  ADMISSIBILITY 
C 

IF  (N I .GT.O  .AND.  NI.LE.NUMNP)  GOTO  1 50 
N = N I 

145  WRITE  (6,3090)  N.NEL 
STOP 

150  IF  (NJ. GT.O  .AND.  NJ.LE.NUMNP)  GO  TO  155 
N = NJ 
GO  TO  145 

155  IF  (MAT. GT.O  .AND.  MAT . LE . NUMMAT)  GO  TO  160 
WRITE  (6,3100)  MAT, NEL 
STOP 

160  IF  (IS. GT.O  .AND.  IS.LE.NPROP)  GO  TO  1 65 
WRITE  (6,3110)  IS, NEL 
STOP 

165  CONTINUE 
C 

C DETERMINE  IF  THIS  ELEMENT  IS  COMMON  TO  A BRANCH  POINT 
C 

IF  (NBPN.LT. 1)  GO  TO  1700 
C 

KB  (1)  - N I 
KB  (2)  - NJ 
DO  1650  NEND-1,2 
DO  1620  K* 1 , NBPN 

IF  (NODBR(K)  .NE.KB(NEND))  GOTO  1620 
KEL  - NEL 
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IF  (NEND.EQ.2)  KEL  = -KEL 
LOC  = K 
GO  TO  1630 
1620  CONTINUE 
GO  TO  1650 

1630  DO  1640  J-l.MAXTAN 

IF  (NEBR(LOC.J)  .NE.O)  GO  TO  1640 
NEBR(LOC.J)  = KEL 
GO  TO  1650 
1640  CONTINUE 

WRITE  (6,4020)  MAXTAN , KB  (NEND) 

MODEX  = 1 
GO  TO  1700 
1650  CONTINUE 
1700  CONTINUE 
C 

C COMPUTE  GEOMETRIC  DATA  FOR  THE  TANGENT  ELEMENT 
C 

X1P(1)  - X (N  I ) 

X1P  (2)  = Y (Nl) 

XI  P (3)  - Z(NI) 

X2P  (1 ) = X (NJ) 

X2P  (2)  - Y (NJ) 

X2P  (3)  = Z (NJ) 

C 

CALL  TANGDC  (NEL.X1P.X2P, AC, DC, MODEX, XLN) 

C 

C SELECT  PROPERTIES  FROM  THE  MATERIAL  TABLE 
C 

TAVG  = 0.5*(T(NI)+T(NJ)) 

CALL  SELECT  (MAT, NEL , TAVG ,TM, E , XNU , ALP .MAXTP , YM, POS, THERM) 

C 

c***  DATA  porthole  save 
I F (MODEX. EQ. 1) 

*WR I TE  (NT8)  XLN, DC, YM, POS, THERM 

I F (MODEX. EQ. 1)  GO  TO  510 
C 

C TEST  TO  SEE  IF  NEW  ELEMENT  MATRICES  ARE  REQUIRED 
C 

DUM  -ABS  (XLN1-XLN)  +ABS  (TR1 -TR)  +ABS(PR1-PR)  +ABS (TAVG 1 -TAVG) 
IDUM  - I ABS  (MAT1-MAT)  + lABS(ISl-IS) 

DUM  - DUM  +DFLOAT ( I DUM) 

I F (DUM.GT . 1 .OE-6)  GO  TO  180 
DO  170  1-1,2 
DO  170  J-1,2 

DU2  =ABS  (DC  1 (I , J) -DC  ( I ,J)) 

DU3  -ABS  (DC  (I  ,J)*1  .OE-6) 

I F (DU2.GT.DU3)  GO  TO  180 
170  CONTINUE 
GO  TO  510 
C 

180  XLN 1 = XLN 
TR 1 = TR 
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PR  1 = PR 

TAVG 1 = TAVG 
MAT1  = MAT 
IS1  = IS 
DO  185  1-1,2 
DO  185  J=1 , 2 
185  DC  1 (I ,J)  = DC  (I , J) 

C 

C GENERATE  THE  TANGENT  ELEMENT  STIFFNESS,  LOAD  AND  STRESS  MATRICES 
C 

SHEAR  = ALFAV(IS) 

NODE  = NJ 
NELEMT  = NEL 
PARA3  = XLN 
PRESS  = PR 
SECTA  = AREA  (IS) 

SECTI  = XMI  (IS) 

SECTW  = WALL  (IS) 

SECTD  = DOUT(IS) 

SECTM  = XMAS  (IS) 

C **** 

I F (NPAR  (1  1)  . LT.  1)  GO  TO  67  1 0 

WRITE  (6,5000)  SHEAR, NODE, NELEMT, PARA3, PRESS, SECTA, SECTI , SECTW, 

1 SECTD, SECTM 

WRITE  (6,5010)  ((DC(I,J),J-1,3)  ,1-1,3) 

WRITE  (6,5020)  TAVG, YM.POS, THERM 
6710  CONTINUE 
C**** 

c 

CALL  TANGKS 
C 

NS  = 12 

DELT  = TAVG  - TR 
WGT  = XWGT(IS) 

C 

GO  TO  400 
C 

C BEND  ELEMENT 
C 

300  L = L+l 

CTAG  = TG4 

IF  (LINE. LT. 57)  GO  TO  305 
WRITE  (6,2110) 

LINE  - 7 
305  CONTINUE 

WRITE  (6,2125)  INEL.HED1  (2, 1) ,HED1  (2,2)  , INI , INJ, I MAT, ISP.TRI , PR  I , 
1 XTAG.CTAG 

C***  DATA  PORTHOLE  SAVE 
I F (MODEX.EQ. 1) 

*WR I TE  (NT8)  INEL, ITYP, INI , INJ, IMAT, ISP.TRI ,PRI 

READ  (5,1050)  RADIUS, P3T.X3P.T0L 
I F (TOL.LT. 1 .0E-8)  TOL  = 0.1 
WRITE  (6,2130)  RADIUS, P3T.X3P, TOL 
LINE  = LINE  +3 
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KODE  = I 

I F (P3T.EQ.TG5  ) KODE  = 2 
C***  DATA  PORTHOLE  SAVE 
IF (MODEX.EQ. 1) 

*WRITE  (NT8)  RADIUS, KODE, X3P.TOL 

Crtrt* 

c 

C TEST  INPUT  DATA  FOR  ADMISSIBILITY 
C 

K = NEL  +1 

IF  (INEL.EQ.K)  GO  TO  310 
WRITE  (6,4000)  I NEL, K 
STOP 

310  NEL  = INEL 
N I = INI 
NJ  = INJ 

IF  (INI .GT.O  .AND.  INI . LE .NUMNP)  GO  TO  320 
N = INI 

315  WRITE  (6,3090)  N,  INEL 
STOP 

320  IF  (INJ. GT.O  .AND.  I N J . LE . NUMNP)  GO  TO  330 
N = INJ 
GO  TO  315 

330  I F ( I MAT .GT.O  .AND.  I MAT . LE . NUMMAT)  GO  TO  340 
WRITE  (6,3100)  I MAT , I NEL 
STOP 

340  IF  (ISP. GT.O  .AND.  I SP . LE . NPROP)  GO  TO  350 
WRITE  (6,3110)  ISP, INEL 
STOP 

350  IF  (RADIUS. GT. 1 .OE-8)  GOTO  3&0 
WRITE  (6,4010)  INEL 
STOP 

360  CONTINUE 
C 

C COMPUTE  GEOMETRIC  DATA  FOR  THE  BEND  ELEMENT 
C 

X1P(1)  * X (N  I ) 

X 1 P (2)  = Y (N  I ) 

XI P (3)  = 2 (N  I ) 

X2P  (1)  - X (NJ) 

X2P  (2)  * Y (NJ) 

X2P  (3)  * Z (NJ) 

TOL  - TOL*WALL  (ISP) 

C 

CALL  BENDDC  (INEL, INI , I NJ , XI P , X2P , X3P . RAD  I US , KODE , DC, MODEX, THETA , 
1 TOL.PI) 

C 

C SELECT  PROPERTIES  FROM  THE  MATERIAL  TABLE 
C 

TAVG  - 0 .5* (T  ( I N I ) +T  ( I NJ) ) 

c 

CALL  SELECT  (IMAT. INEL, TAVG, TM, E.XNU, ALP, MAXTP.YM.POS, THERM) 

C 

C***  DATA  porthole  save 

IF  (MODEX. EQ.l) 
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*WRITE  (NT8)  THETA, DC, YM.POS, THERM 

C*** 

I F (MODEX.EQ. 1)  GO  TO  510 
C 

C CALCULATE  THE  BEND  FLEXIBILITY  FACTOR 
C 


C 

c 

C 


C **** 


CALL  PIPES3  (WALL  (ISP) , RAD  I US , DOUT ( I SP) , YM, PR  I , XKP) 

GENERATE  THE  ELEMENT  STIFFNESS,  LOAD  AND  STRESS  MATRICES 

SHEAR  = ALFAV(ISP) 

NODE  = INJ 
NELEMT  = INEL 
PARA  1 = XKP 

PARA2  = THETA 
PARA3  = RADIUS 
PRESS  = PRI 
SECTA  = AREA  (ISP) 

SECTI  = XMI  (ISP) 

SECTW  = WALL  (ISP) 

SECTD  = DOUT  (ISP) 

SECTM  = XMAS  (ISP) 


IF  (NPAR(ll)  . LT . 1 ) GO  TO  6711 

WRITE  (6,5100)  SHEAR, NODE, NELEMT, PARA1 .PARA2.PARA3, PRESS, SECTA, 
1 SECTI .SECTW, SECTD, SECTM 

WRITE  (6,5110)  ( (DC  (I  , J)  , J=1  ,3)  • 1 = 1.3) 

WRITE  (6,5120)  TAVG, YM.POS, THERM 
6711  CONTINUE 
C**** 

C 


CALL  BENDKS 
C 


DELT  = TAVG-TR I 
WGT  - XWGT(ISP) 

XLN 1 = 0.0 
ML  = 0 
NS  = 18 
C 

C TRANSFORM  THE  ELEMENT  STIFFNESS  MATRIX  FROM  LOCAL  TO 
C GLOBAL  COORDINATES 
C 

1*00  CONTINUE 

DO  1*50  IR-1,10,3 
IRS  - IR-1 
DO  440  IC-IR.10,3 
ICS  - IC-1 


c 


DO  410  1-1,3 
II  - IRS+I 
DO  410  J«l,3 
JJ  - ICS+J 
Q ( I ,J)  - S (I  I ,JJ) 
410  CONTINUE 


C 


o o o 
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DO  420  1*1,3 
DO  420  J*1 ,3 
QQ  ( I , J)  * 0.0 
DO  415  KN-1,3 

QQ(I.J)  - QQ  (I  , J)  + Q(I,KN)*  DC(J,KN) 

415  CONTINUE 
420  CONTINUE 
C 

DO  430  1*1,3 
II  * IRS+I 
DO  430  J*1 , 3 
JJ  = ICS+J 
S (I  I , JJ)  =0.0 
DO  425  KN=1 , 3 

S(II.JJ)  = S (I  I , J J)  + DC(I,KN)*  QQ(KN.J) 

425  CONTINUE 
430  CONTINUE 
C 

440  CONTINUE 
450  CONTINUE 
C 

DO  460  1-1,12 
DO  460  J* I , 12 
S (J , I ) = s ( I , J) 

460  CONTINUE 

C FORM  THE  ELEMENT  MATRICES  ASSOCIATED  WITH  EACH  OF  THE  FOUR  (A,B, 

C C AND  D)  ELEMENT  LOADING  COMBINATIONS 

C 

DO  500  LC= 1 ,4 
C 

C 1.  FORM  THE  PARTICIPATION  FACTORS  FROM  THE  FIVE  TYPES  OF 

C LOADING  FOR  THIS  ELEMENT  LOAD  CASE 

C 

DO  475  1=1.3 
FAC(I)  = 0.0 
DO  470  J-1,3 

470  FAC(I)  = FAC  ( I ) + DC  (J  , I ) * EMUL(J.LC) 

FAC  (I)  - FAC  (I)  * WGT 

475  CONTINUE 

FAC  (4)  - EMUL  (4, LC)  * DELT 
FAC  (5)  - EMUL  (5 , LC) 

2.  COMPUTE  THE  FORCES  ACTING  ON  THE  NODES  IN  THE  LOCAL  SYSTEM 

00  485  1=1. ND 
RF  (I  , LC)  - 0.0 
DO  480  J*1 ,5 

RF  (1  .LC)  = RF  (I  , LC)  - FEF(I.J)*  FAC(J) 

480  CONTINUE 
485  CONTINUE 

3.  TRANSFORM  THE  LOCAL  NODE  FORCES  TO  THE  GLOBAL  SYSTEM 
C 


o o o 
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DO  489  IR-1 , 10,3 
IRS  - IR-1 
C 

DO  486  1=1,3 
J = IRS+I 

486  Q(l  , 1)  = RF  (J.LC) 

C 

DO  488  M=1 ,3 
J = IRS+M 
RF  (J , LC)  =0.0 
DO  487  KN-1,3 

RF  (J , LC)  = RF  (J , LC)  + DC  (M,  KN)  * Q(KN,1) 

487  CONTINUE 

488  CONTINUE 
C 

489  CONTINUE 
C 

C 4.  FORM  THE  FIXED-END  STRESS  RESULTANT  CORRECTIONS 

C 

DO  495  1=1 , NS 
SF  (I  , LC)  = 0.0 
DO  490  J=1 ,5 

SF  ( I , LC)  = SF(I.LC)  + FEFC(I,J)*  FAC  (J) 

490  CONTINUE 
495  CONTINUE 

C 

500  CONTINUE 
C 

C FORM  THE  ELEMENT  EQUATION  NUMBER  ARRAY 
C 

510  DO  515  K-1,6 

LM(K)  = I D (N  I , K) 

515  LM  (K+6)  = I D (N  J , K) 

C 

C SAVE  THE  STIFFNESS  AND  APPLIED  LOAD  MATRICES  FOR  LATER  ASSEMBLY 
C 

CALL  CALBAN  (MBAND , ND I F , LM, XM, S , RF , ND , ND , NS) 

C 

C SAVE  THE  STRESS  RECOVERY  INFORMATION 
C 

WRITE  (1)  ND , NS , (LM  ( I ) , 1=1 , ND) , ( (SA  ( I , J) , 1 = 1 ,NS) , J=1 , ND) , 

1 ((SF  (I ,J)  , 1=1, NS)  ,J=1 ,4) 

CHECK  FOR  THE  LAST  ELEMENT 

520  IF  (NPIPE-NEL)  120,600,530 
530  I F (ML.GT.O)  GO  TO  115 
IN  - INI 
JN  = INJ 
I NCR  = INC 
GO  TO  100 
C 

600  I F (NBPN.LT. 1)  RETURN 
C 

C PRINT  BRANCH  POINT  SUMMARY 
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WRITE  (6,2140) 
DO  620  K=1 , NBPN 


DO  610  J-l .MAXTAN 
HEDBR(J)  - HD1 

IF  (NEBR(K.J)  .GT.O)  HEDBR(J)  = HD2 
IF  (NEBR(K.J)  .LT.O)  HEDBR(J)  = HD3 
610  CONTINUE 


WRITE  (6,2150)  K.NODBR(K)  , (NEBR(K.L)  ,HEDBR(L)  ,L«1, MAXTAN) 
620  CONTINUE 
C 

KODEX  = MODEX 
RETURN 


C FORMAT 
C 

1000  FORMAT 
1005  FORMAT 
1010  FORMAT 
1020  FORMAT 
1030  FORMAT 
1040  FORMAT 
1050  FORMAT 


STATEMENTS 

(2  I 5.6A6) 

(4F10.0) 

(I5.5F10.0.3A6) 

(1015) 

(4F10.0) 

(14, A1 , 4 I 5,5F 10.0 , 15) 

(F10.0,3X,A2,4F10.0) 


2000  FORMAT 
1 

2 

3 

4 

5 

6 

7 

2005  FORMAT 
1 

2 

2010  FORMAT 
2020  FORMAT 
1 
2 
3 


(7X.33HNUMBER  OF  PIPE  ELEMENTS 
7X.33HNUMBER  OF  MATERIAL  SETS 
7X , 26HMAX I MUM  NUMBER  OF  MATERIAL, 

7X , 33HTEMPERATURE  INPUT  POINTS 
7X , 33HNUMBER  OF  SECTION  PROPERTY  SETS 
7X.33HNUMBER  OF  BRANCH  POINT  NODES 
7X , 26HMAX I MUM  NUMBER  OF  TANGENTS, 
7X.33HCOMMON  TO  A BRANCH  POINT 
(7X , 25HF LAG  FOR  NEGLECTING  AXIAL, 

7X , 33HDE FORMAT  I ONS  IN  BEND  ELEMENTS 
7X,15H(EQ.l,  NEGLECT) , //  IX) 

(//48H  MATERIAL  PRO 
(// ' OMATER I AL  NUMBER  = (' 

1 10H  NUMBER  OF  1 , 

• 23H  TEMPERATURE  POINTS  = 

1 23H  IDENTIFICATION 


16 

= , 16 

= , 16 
= , 16 
= , 16 

= , 16  //  IX) 
= , 16 


// 

// 

/ 

// 

// 

// 

/ 

// 

/ 

/ 


PERTY  TABLE  S./1X) 
4, 1H) ,/ 

/ 

[ 1 , I 4, 1 H) ,/ 

(' ,6A6, 1H) ,// 


4 '2X.5HP0INT, 19X,7HYOUNG*S,3X,  9HP0 I SS0N*S,5X,7HTHERMAL 1 ,/ 


5, ' 3X , 1 1HTEMPERATURE,5X,7HM0DULUS,7X,5HRATI0,3X,9HEXPANSI0N' , / IX) 

2030  FORMAT  (I7,F14.2,F12.1,F12.3.E12.3)  , r #/ 

2040  FORMAT  (44H1S  ECTION  PROPERTY  TABLE,// 

1 8H  SECTION, 4X, 7H0UTSIDE, 8X, 4HWALL, 3X, 12HSHAPE  FACTOR, 7X , 

2 7HWEIGHT/,  9X.5HMASS/,  / 8H  NUMBER, 3X.8HD I AMETER, 3X , 9HTH I CKNESS , 

3 6X.9HF0R  SHEAR, 2(3X,UHUNIT  LENGTH)  .3X.21HD  E S C R I P T I 0 N, 


4 / IX) 

2050  FORMAT  (I8,F11.3,F12.4,F15.4,2E14.4,3X,3A6) 

2060  FORMAT  (44H1B  RANCH  POINT  NODE  LIST,  ///IX) 
2070  FORMAT  (7H  BRANCH ,5X, 4HN0DE , /2X.5HPO I NT, 3X.6HNUMBER , / IX) 

2080  FORMAT  (17.19) 
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2090  FORMAT  (///34H  ELEMENT  LOAD  CASE,  3X, 

1  2 1 HM  U L T I P L I E R S,  //  31X.6HCASE  A.4X.6HCASE  B.4X, 

. 6HCASE  C 
2,4X, 'CASE  D 1 ) 

2100  FORMAT  (5X , 1 9HX-D  I RECT I ON  GRAVITY,  3X,  i»F  10 - 3 / 

1 5X,  1 9HY-D  I RECT  I ON  GRAVITY,  3X,  i*F  10 . 3 / 

2 5X , 1 9H2-D  I RECT  I ON  GRAVITY,  3X,  i»F  10 . 3 / 

3 5X,  19HTHERMAL  DISTORTION,  3X,  4F10.3,  / 

4 5X , 1 9HPRESSURE  DISTORTION,  3X,  4F10.3,  //  IX) 

2110  FORMAT  (46H1P  IPE  ELEMENT  INPUT  DATA,  //IX, 

1 7HELEMENT,2X,7HELEMENT,2(2X,4HNODE) ,3X,5HMATL.,2X,7HSECTI0N,i*X, 

2 9HREFERENCE,2X,8HINTERNAL,3X, 17HD  I R E C T I 0 N,3X, 

313HC  0 S I N E S,7X,4HN0DE,2X,5H INPUT,  / 2X,6HNUMBER,5X,4HTYPE ,4X, 

4 2H-I ,4X,2H-J,2X,6HNUMBER,3X,6HNUMBER,2X,1 1HTEMPERATURE , 2X, 

5 8HPRESSURE.7X,5HA(YX) ,7X,5HA(YY) ,7X,5HA(YZ) , 2X , 9H I NCREMENT, 4X , 

6 3HTAG,/  51X.5H  (BEND,6X,6H(THIRD,3X,4H(X3-,8X,4H(Y3-,8X,4H(Z3-,7X, 

7 5H  (WALL , / 52X.7HRADIUS)  .4X.6HP0INT) ,3(3X,9HORDINATE)) ,2X, 

8 9HFRACT I ON)  , / IX) 

2120  FORMAT  (3X , 1 5, 2X, A6, A1 , 2 1 6, 3X, 1 5, 4X, 1 5, F 1 1 . 2 , F 1 2 . 2 , 3F 1 2 .4, I 6, 

1 10X.2A1) 

2125  FORMAT  (3X, 15, 2X, A6, A1 ,2  I 6, 3X, I 5,4X, I 5, F 1 1 .2, F 12.2,52X,2A1) 

2130  FORMAT  (48X,1H(,F9.3,1H) ,4X,1H(,A2,1H) ,2X,3(1H(,F10.3,1H)  ),1X, 

1 1H  (, F8.4, 1H) , / IX) 

2140  FORMAT  (34H1B  RANCH  POINT  DATA,  //  7H  BRANCH, 4X, 

1 4HN0DE , / 7H  POINT, 2X,6HNUMBER,3X,21HC  ONNECTIONS, 

2 6H  . . . , / IX) 

2150  FORMAT  (17, 18,8  (3X, 16, A5)  ) 

C 

3000  FORMAT  (41H0ERR0R***  MATERIAL  NUMBER  EXCEEDS  TOTAL.,  / IX) 

3010  FORMAT  (44H0ERR0R***  MATERIAL  NUMBER  IS  LESS  THAN  ONE.,  / IX) 

3020  FORMAT  (52HOERROR***  NUMBER  OF  TEMPERATURE  POINTS  EXCEEDS  USER, 

1 10H  MAXIMUM  (, I4.2H) .,  / IX) 

3030  FORMAT  (50HOERROR***  TEMPERATURES  MUST  BE  INPUT  IN  ASCENDING, 

1 7H  ORDER.,  / IX) 

3040  FORMAT  (27HOERROR***  SECTION  NUMBER  (.15,  9H)  IS  BAD.,  / IX) 

3050  FORMAT  (41H0ERR0R***  ZERO  O.D.  FOR  SECTION  NUMBER  (,I4,2H).,/  IX) 
3060  FORMAT  (41H0ERR0R***  ZERO  WALL  FOR  SECTION  NUMBER  (, I 4 , 2H)  . , /l X) 
3070  FORMAT  (25H0ERR0R***  BRANCH  POINT  (,I4,21H)  HAS  AN  ILLEGAL  NODE, 

1 1 8H  NUMBER  REFERENCE.,  / IX) 

3080  FORMAT  (27HOERROR***  ELEMENT  NUMBER  ( ,'l  4 , 1 2 1 H)  IS  OUT  OF 
1 SEQUENCE1 ,/  IX) 

3090  FORMAT  (17H0ERR0R***  NODE  (, 1 4 , 1 4H)  OF  ELEMENT  (,I4,4H)  IS, 

1 9H  ILLEGAL.,  / IX) 

3100  FORMAT  (28HOERROR***  MATERIAL  NUMBER  (.I4.19H)  GIVEN  FOR  ELEMENT, 

1 9H  NUMBER  (,I4,13H)  IS  ILLEGAL.,  / IX) 

3110  FORMAT  (36HOERROR***  SECTION  PROPERTY  NUMBER  (,I4,11H)  GIVEN  FOR, 

1 17H  ELEMENT  NUMBER  (.14,1 3H)  IS  ILLEGAL.,  / IX) 

C 

4000  FORMAT  (25HOERROR***  BEND  ELEMENT  (.I4.21H)  IS  OUT  OF  SEQUENCE., 

1 / 1 IX,  3 1 HEXPECT  TO  READ  ELEMENT  NUMBER  (,I4,1H),  / IX) 

4010  FORMAT  (47HOERROR***  ZERO  RADIUS  GIVEN  FOR  BEND  ELEMENT  (.14, 

1 2H)  .,  / IX) 

4020  FORMAT  (22HOERROR***  MORE  THAN  ( , 1 4 , 22H)  TANGENT  ELEMENTS  ARE, 

1 24H  COMMON  TO  BRANCH  NODE  (, 1 4 , 2H) . , / IX) 
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5000  FORMAT 
1 
2 

3 

4 

5 

6 

7 

8 
9 


(// 


10H 
10H 
10H 
10H 
10H 
10H 
10H 
1 0H 
10H 
10H 


SHEAR 

NODE  J =, 
ELEMENT  =, 
LENGTH  = , 
PRESSURE* , 
AREA 

INERTIA  = , 

WALL 

O.D. 

MASS 


E 1 3 • 4 

14 

14 

E 1 3 - ^ 
E13-1* 
E 1 3 - ^ 
E13.4 
E13-1* 
E 1 3 - 4 
E13.4 


/ 

/ 

/ 

/ 

/ 

/ 

/ 

/ 

/ 

//) 


5010  FORMAT 

(// 

1 8H 

DIRECTION  COSINES,  // 

5020  FORMAT 

(// 

14H 

T (AVERAGE) 

= , E 1 3 

1 

1 4H 

YOUNG*S  MOD 

=,  E13.4 

2 

POISSON*S 

= , El  3*1* 

3 

1 kH 

THERMAL  EXP 

=,  E13-4 

5100  FORMAT 

(// 

10H 

SHEAR 

E13-J+  / 

1 

1 OH 

NODE  J =, 

14  / 

2 

10H 

ELEMENT  =, 

14  / 

3 

1 0H 

KAPPA 

E13-1*  / 

4 

1 OH 

THETA 

E 1 3 • 4 / 

5 

10H 

RADIUS  =, 

E13-J+  / 

6 

10H 

PRESSURE*, 

E 1 3 • 4 / 

7 

10H 

AREA 

E 1 3 - ^ / 

8 

1 OH 

INERTIA  *, 

E 1 3 - ^ / 

9 

10H 

WALL 

E13-1*  / 

A 

10H 

O.D. 

E13-1*  / 

B 

10H 

MASS 

E 1 3 //) 

(3F15.8) 

/ 

/ 

/ 

//) 


5110  FORMAT 
5120  FORMAT 
1 
2 
3 


(// 

(// 


i8h 
14H 
14H 
1 4H 
14H 


DIRECTION 
T (AVERAGE) 
YOUNG*S  MOD 
POISSON*S 
THERMAL  EXP 


COS 


NES,  //  (3F 15-8) 

E13-1*  / 

E 1 3 -1*  / 

E 1 3 - ^ / 

E 1 3 //) 


C 

C 

c 

c 


END 

SUBROUTINE  PLANE 


CALLS? 

CALLED 


PLNAX.STRSC 
BY?  ELTYPE 


/one/  A (1) 

/ELPAR/  NPAR (14)  , NUMNP,MBAND,NELTYP,N1 ,N2,N3,N4,N5,MTOT,NEQ 
/EM/  NS.ND.B  (42,63)  .Tl  (42,4)  ,LM(63) 

/JUNK/  LT.LH, L, I PAD.SG (20) , S I G (7) , EXTRA  (150) ,N6,N7,N8,N9, 
N10.N1 1 ,N1 2, I F I LL  (65) 

/EXTRA/  MODEX,NT8,N10SV,NT10, I F I LL2 
/say/  neqq , numee , 1 oopur , nnb 1 ock , n terms ,opt i on 
/what/  naxa  (10000) , i row!  (10000) , i col h (10000) 

DIMENSION  STRLAB  (5) 

DATA  STRLAB/3HCEN.3HL-I , 3HJ-K, 3H I -J , 3HK-L/ 


COMMON 

COMMON 

COMMON 

COMMON 

1 

COMMON 

common 

common 


IF  (NPAR  (1) . EQ.O)  GO  TO  200 
IF  (NPAR(l)  .EQ.3)  NPAR(5)=2 
IF (NPAR (5)  .EQ.O)  WRITE  (6,2000) 
I F (NPAR (5) • EQ. 1)  WRITE  (6,2001) 


C 
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IF  (NPAR  (5)  . EQ . 2)  WRITE  (6,2002) 

IF  (NPAR  (1)  . EQ. 3)  WRITE  (6,2003) 

IF  (NPAR  (6)  .NE .0)  WRITE  (6,2004) 

IF (NPAR  (3)  . EQ.O)  NPAR  (3) =1 
I F (NPAR  (4)  . EQ.O)  NPAR(4)=1 
N6=N5+NUMNP 
N7=N6+NPAR (3) 

N8-N7+NPAR (3) 

N9-N8+NPAR (3) 

N10=N9+NPAR (3) 

N 1 1 =N 1 0+ 1 1*NPAR (4) *NPAR (3) 

N12-N1 1+240 
MM=N 1 2+240-MTOT 
IF(MM.GT.O)  CALL  ERROR  (MM) 

C 

CALL  PLNAX  (A  (N 1 ) ,A(N2)  ,A(N3)  ,A(N4)  , A (N5)  ,A(N6)  ,A(N7)  tA(N8)  , 
1 A(N9)  , A (N 1 0)  , NPAR  (4)  ,NUMNP,A  (N1 1)  ,A(N12)) 

C 

RETURN 

C 

200  WRITE  (6,2006) 

NUME-NPAR (2) 

DO  800  MM=1 ,NUME 

CALL  STRSC  (A  (N 1 ) , A (N 3)  ,NEQ,0) 

C ***  STRESS  PORTHOLE 
IF  (N10SV.EQ. 1) 

*WRITE  (NT  10)  NS 
I F (NS.EQ. 1)  GO  TO  800 
WRITE  (6,3000)  MM 
DO  700  L=LT, LH 

CALL  STRSC  (A  (Nl)  ,A  (N3)  ,NEQ,  1) 

I TAG  =0 

510  DO  600  KK=1 , NS , 4 
I TAG  - I TAG  + 1 
DO  520  1=1,4 
I l-KK-l+l 

520  S I G ( I ) =SG  (II) 

CC=  (S  I G ( 1 ) +S  I G (2) ) /2 .0 
BB=  (SIG  (1)  -SIG  (2))/2. 

CR=SQRT  (BB**2+S I G (4) **2) 

SIG  (5) =CC+CR 
SIG  (6)=CC-CR 
SIG  (7) =0.0 

IF  ((BB.EQ.O.O)  .AND.  (S I G (4) . EQ.O .0) ) GO  TO  530 
SIG  (7)=28.648*ATAN2  (SIG  (4)  ,BB) 

C***  STRESS  PORTHOLE 
530  IF  (N10SV.EQ.1) 

*WR I TE  (NT  10)  MM, L , (SIG  (I) ,1=1,7) 

600  WRITE  (6,3001)  L , STRLAB  ( I TAG) , (S I G ( I ) , I = 1 , 7) 

WRITE  (6,3002) 

700  CONTINUE 
800  CONTINUE 
RETURN 

2000  FORMAT  (22H 1 AX  I SYMMETR I C ANALYSIS  ) 

2001  FORMAT  (22H 1 PLANE  STRAIN  ANALYSIS  ) 
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2002  FORMAT 

2003  FORMAT 
2001*  FORMAT 
2006  FORMAT 

1 

2 

3 

k 

3000  FORMAT 
1 

2 

3001  FORMAT 

3002  FORMAT 
END 


(22H 1 PLANE  STRESS  ANALYSIS  ) 

(18H  MEMBRANE  ELEMENTS  ) 

(30H  INCOMPATIBLE  MODES  SUPPRESSED  ) 

(54H1T  WO-D  I MENS  I ONAL  FINITE  ELEM, 
8H  E N T S,///  8X.32H1.  CENTROID  STRESSES  REFERENCED, 

26H  TO  LOCAL  Y-Z  COORDINATES.,/  8X,  12H2.  MID-SIDE, 

5 1 H STRESSES  ARE  NORMAL  AND  PARALLEL  TO  ELEMENT  EDGES., 

//  IX) 

(10H0ELEMENT  (,I5,1H),//  2X , 4HL0AD , 2X, 3HL0C , 1 2X , 3HS 1 1 , 1 2X , 
3HS22, 12X.3HS33, 1 2X, 3HS 1 2 , 10X.5HS-MAX, 10X.5HS-MIN.5X, 
5HANGLE,  / IX) 

(l6,2X,A3,6E15.5,F10.2) 

(1H0) 


s8  . f r C 

SUBROUTINE  PIPES2  (DOUT.WALL, ALFAV, AREA.XMI ,PI) 


C 

C CALLED  BY?  PIPEK 

C 

C SECTION  PROPERTY  COMPUTATIONS  FOR  PIPE  SECTIONS 

= OUTSIDE  DIAMETER 
= WALL  THICKNESS 

= SHAPE  FACTOR  FOR  SHEAR  DISTORTION 
= CROSS  SECTIONAL  AREA 
= SECTION  PRINCIPAL  MOMENT  OF  INERTIA 

C 

common  /say/  neqq , numee, 1 oopur , nnbl ock , nterms .opt t on 
common  /what/  naxa  (10000) , i rowl  (10000) , icolh  (10000) 

ROUT  = DOUT  * 0.5 
R I N ■ ROUT  - WALL 
R0UT2  = R0UT**2 
RIN2  = RIN**2 
C AREA 

AREA  = PI*  (R0UT2  - RIN2) 

C MOMENT  OF  INERTIA 

XMI  = 0.25*  PI*  (R0UT2**2  - RIN2**2) 

C SHAPE  FACTOR 

IF  (ALFAV. GT. 99- 99)  RETURN 

DUM2  = 1.333333333333*  (R0UT2*  ROUT  - RIN2*  RIN) 

DUM3  * (R0UT2  + RIN2)  * WALL 
I F (DUM3-LT. 1 .OE-8)  STOP  701 
ALFAV  - DUM2/  DUM3 


C DOUT 

C WALL 

C ALFAV 

C AREA 

C XMI 


C 

RETURN 

END 

SUBROUTINE  PIPES3  (WALL , RAD , DOUT , E , P, XKP) 

common  /say/  neqq, numee, 1 oopur, nnbl ock, nterms, opt  ion 
common  /what/  naxa  (10000) , i rowl  (10000) , i col h (10000) 

C 

C CALLED  BY?  PIPEK 

C 

C CALCULATION  OF  PRESSURE  DEPENDENT  FLEXIBILITY  FACTOR 

C 
C 


WALL 


WALL  THICKNESS 
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C RAD 

C DOUT 
C E 

C P 

C XKP 

C RM 

C 

RM  = (DOUT  - WALL) * 0.5 
IF  (RM. LT. 1 .OE-8)  STOP  702 
H * WALL*  RAD/  RM**2 
IF  (H.LT.l .OE-8)  STOP  703 
IF  (E.LT. 1 .OE-8)  STOP  704 
DUM  = 6.0*  P/  E/  H 
I F (WALL . LT . 1 .OE-8)  STOP  705 
DUM2  * (RAD/  WALL)**  1.333333333333 
DUM  *1.0+  DUM*  DUM2 
XKP  = (1.65/  H)/  DUM 
IF (XKP.LT. 1 .0)  XKP  * 1 .0 
C 

RETURN 

END 

SUBROUTINE  PLNAX  ( I D , X , Y , Z,T , NTC , WT, RO, WANG , E ,NUMTC , NUMNP , B , BB) 

C CALLS?  ELAW, QUAD, VECTOR, CROSS, DOT, CALBAN 

C CALLED  BY?  PLANE 

C 

DIMENSION  X(l)  ,Y(1)  ,Z(1)  .ID  (NUMNP,  1)  ,NTC(1)  ,WT(1)  ,R0(1)  .WANG  (1)  , 

1 E (NUMTC,  11,1)  , T ( 1 ) , B (20,  1 2)  ,BB(20,12) 

COMMON  /ELPAR/  NPAR(14) ,NUMNN,MBAND,NELTYP,N1 ,N2,N3,N4,N5,MT0T,NEQ 
COMMON  /EM/  LM  (12)  ,S  (12,  12)  , P ( 1 2 , 4)  ,XM(12)  , 

1 T I (20,4)  , IX  (4)  , IE  (5)  ,NS,D(4,4)  , EMUL  (4.5)  ,RR(4)  ,ZZ(4)  ,H  (6)  ,HS  (6)  , 

2 HT(6)  ,HR(6)  ,HZ(6)  , FAC, XMM, PRESS,  EE  (10)  ,TTI  (4)  ,PP(12,4)  .THICK 

3 , TMP  (4)  ,TP  (1 2)  , ALP  (4)  , I F I LL2  (4236) 

COMMON  /JUNK/  MAT, NT, TEMP, REFT, BETA, U (4) ,V(4) ,W(4) ,G (4) , I FLL (390) 
COMMON  /EXTRA/  M0DEX.NT8, I F I LL3  (14) 

common  /say/  neqq , numee, 1 oopur , nnb 1 ock , nterms ,opt i on 
common  /what/  naxa  (10000) , i rowl  (10000) , icolh  (10000) 

C 

NUME*NPAR  (2) 

NUMMAT-NPAR (3) 
numee=nume 
neqq*neq 

WRITE  (6,2000)  (NPAR(M)  ,M-2,6) 

C 

C READ  AND  PRINT  OF  MATERIAL  PROPERTIES 
C 

DO  60  M-l.NUMMAT 

READ  (5.1010)  MAT, NTC  (MAT) ,WT  (MAT) ,R0 (MAT)  , WANG (MAT) 

IF  (NTC (MAT) .EQ.O)  NTC  (MAT) -1 
WRITE  (6,2020)  MAT, NTC (MAT) ,WT (MAT) ,R0  (MAT)  , WANG (MAT) 

NT-NTC  (MAT) 

READ  (5.1005)  ( (E (I ,J,MAT) ,J=1, 1 1) , 1*1, NT) 

WRITE  (6,2010)  ((E (I ,J,MAT) ,J*1 , 1 1) , 1=1, NT) 

60  CONTINUE 

C***  DATA  PORTHOLE  SAVE 
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= RADIUS  OF  THE  BEND 
= OUTSIDE  DIAMETER  OF  THE  PIPE 
= YOUNG*S  MODULUS 
= INTERNAL  PRESSURE 
= FLEXIBILITY  FACTOR 
= MEAN  RADIUS  OF  THE  PIPE 
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I F (MODEX.EQ.O)  GO  TO  75 
DO  70  M=1 , NUMMAT 

WRITE  (NT8)  M,NTC(M)  ,WT(M)  ,WANG(M) 

NT  = NTC(M) 

WRITE  (NT8)  ( (E  (I  ,J,M)  , J=1  , 1 1)  , 1 = 1 ,NT) 

70  CONTINUE 
75  CONTINUE 
C 

C ELEMENT  LOAD  CASE  MULTIPLIERS 

READ  (5,1002)  ((EMUL  (I  ,J)  ,J=1  ,5)  . 1=1 
WRITE  (6,2004)  ( (EMUL (I , J) , J=1 >5) ,1=1,4) 

C***  DATA  PORTHOLE  SAVE 
I F (MODEX.EQ. 1) 

*WRITE  (NT8)  ((EMUL(I,J)  ,J=1,5)  .1=1.1*) 

C 

c READ  AND  PRINT  OF  ELEMENT  PROPERTIES 

C 

WRITE  (6,2002) 

130  READ  (5 , 1 003)  M,  (I E (I ) ,1  = 1.5)  .REFT, PRESS. NS, KG, THICK 
MAT=  I E (5) 

IF(KG.EQ.O)  KG=1 
IF  (NPAR  (5)  .EQ.l)  TH I CK=1 .0 
IF(NS.EQ.O)  NS=4 
I F (NS  . LT . 4)  NS=1 

| F ( (IE  (3)  .EQ.  IE  (4))  .AND.  (NS.  EQ.  20)  ) NS=l6 
140  N=N+1 

I F (M.EQ.N)  GO  TO  145 
DO  142  1=1,4 
142  I X ( I ) = I X ( I ) +KG 
GO  TO  149 
145  DO  148  1=1,4 

148  I X ( I ) = I E ( I ) 
c 

C FORM  CONSTITUTIVE  LAW  AND  COMPUTE  THERMAL  STRESSES 

C 

149  NT=NTC (MAT) 

WRITE  (6,2003)  N , I X, MAT, REFT, PRESS, NS ,KG,TH I CK 
C***  DATA  PORTHOLE  SAVE 

IF (MODEX.EQ.O)  GO  TO  150 

WRITE  (NT8)  N, IX, MAT, REFT, PRESS, NS, THICK 

GO  TO  153 

150  CONTINUE 
I = I X ( 1 ) 

J=IX  (2) 

K=  I X (3) 

L=  I X (4) 

TEMP  = (T(l)+T(J)+T(K)+T(L))/4.0 
BETA-WANG  (MAT) 

XMM-RO  (MAT) 

WGT*WT  (MAT) 

CALL  ELAW  (NUMTC , EE , E , D ,TT I , ALP) 

C 

C CALCULATE  ELEMENT  STIFFNESS  MATRIX 
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C 

153  IF  (NPAR(l)  . EQ.  3)  GO  TO  160 
ND=8 

DO  155  1=1,4 
I I = I X ( I ) 

RR  ( I ) =Y  ( I I) 

ZZ  ( I ) -2  ( I I) 

TMP  ( I ) = T ( I I ) 

LM  (I ) = I D (I  I , 2) 

155  LM  (1+4)  “I  D (I  I ,3) 

I F (MODEX.EQ. 1)  GO  TO  300 
C 

CALL  QUAD  (B.BB) 

C 

DO  158  1=1,4 
DO  157  L-1,4 

P ( I , L) =P  ( I , L) +XM ( I ) *WGT*EMUL (L , 4) 

157  P (1+4,  L)  =P  (l+4,L)+XM  (I)  *WGT*EMUL  (L , 5) 

XM ( I ) =XM ( I ) *XMM 

158  XM (1+4)  =XM ( I ) 

GO  TO  300 

C 

160  ND  = 12 

IF (MODEX.EQ. 1)  GO  TO  1 65 

CALL  VECTOR  (V,X  (I ) , Y ( I ) , Z ( I ) , X (J)  , Y (J)  , Z (J) ) 
CALL  VECTOR  (G , X ( I ) , Y ( I ) , Z ( I ) , X (L)  , Y (L)  , Z (L) ) 
CALL  CROSS  (V,G,W) 

CALL  CROSS  (W,V,U) 

CALL  VECTOR  (W,X  (I ) , Y ( I ) , Z ( I ) , X (K)  . Y (K)  , Z (K) ) 
RR  (1) =0.0 
ZZ  (1) =0.0 
RR  (2)  =V  (4) 

ZZ  (2) =0.0 

RR  (3)  =W(4)*D0T  (W.V) 

ZZ(3)=W(4)*OOT  (W.U) 

RR  (4)  =G  (4)  *DOT  (G , V) 

ZZ  (4)  =G  (4)  *DOT  (G , U) 

C 

165  DO  170  1=1,4 
I I = I X (I) 

TMP  ( I ) = T ( I I ) 

LM  ( I ) = I D ( I I , 1) 

LM (1+4) * I D ( I 1,2) 

1 70  LM  (1+8)  *ID(II,3) 

IF  (MODEX.EQ. 1)  GO  TO  300 
C 

CALL  QUAD  (B,BB) 

C 

DO  190  1=1,3 
DO  190  K=1 ,4 
KK=4* ( I - 1 ) +K 
DO  180  L=1 , 4 

180  PP(KK,L)=V(I)*P(K,L)+U(I)*P(K+4,L) 

DO  190  J=l ,3 
DO  190  L=1 ,4 
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LL=4* (J- 1 ) +L 

190  BB  (KK,  LL)  =V  (I ) * (S  (K,  L)  *V  (J)  +S  (K,  L+4)  *U  (J) ) 
1 +U  ( I ) * (S  (K+4 , L)  *V  (J)  +S  (K+4 , L+4)  *U  (J) ) 

C 

DO  196  1=1.12 
DO  194  L=1 ,4 
194  P (I  ,L)=PP  (I  . L) 

DO  196  J- I .12 
S (I  , J)  =BB  ( I , J) 

196  S (J.  I)=s  (I  , J) 

c 

DO  210  K= 1 , NS 
DO  200  L=1 ,4 
DO  200  J=1 ,3 
LL=4*  (J- 1)  +L 

200  BB  (K , LL)  =B  (K , L)  *V  (J)  +B  (K , L+4)  *U  (J) 

DO  210  J=1 , 12 
210  B (K , J) =BB  (K , J) 

C 

DO  220  1=1,4 
DO  215  L™ 1,4 

p ( | , L)  =P  ( I , L)+XM(I)*WGT*EMUL  (L.3) 

P (I+4.L)  =P  (l+4,L)+XM  (I)  *WGT*EMUL  (L.4) 

215  p (1+8,  L)  =P  (1+8,  L)+XM  (I)  *WGT*EMUL  (L,5) 

XM  ( I ) =XM ( I ) *XMM 
XM  ( I +4) =XM  ( I ) 

220  XM  (1+8) =XM ( I ) 


CALCULATION  OF  BAND  WIDTH  AND  WRITES  ELEMENT  MATRICES  ON  TAPES 

300  CALL  CALBAN  (MBAND , ND I F , LM, XM, S , P , ND , 1 2 ,NS) 

IF (MODEX.EQ.l)  GO  TO  310 

WRITE  (1)  ND , NS , (LM  ( I ) , I = 1 , ND)  , ( ( B (I , J) , 1=1 ,NS) , J-l ,ND) , 

1  ((Tl  (I  ,J)  ,1=1  ,NS)  . J-l  ,4) 

310  IF  (N . EQ.NUME)  RETURN 
IF (N.EQ.M)  GO  TO  130 
GO  TO  140 


C 


1002  FORMAT  (5F10.0) 

1003  FORMAT  (6I5.2F10.0.2I5.F10.0) 

1005  FORMAT  (8F 10.0/3F10.0) 

1010  FORMAT  (2I5.3F10.0) 

2000  FORMAT  (//  23H  NUMBER  OF  ELEMENTS  =,  16  / 

1 23H  NUMBER  OF  MATERIALS  =,  l6  / 

2 23H  MAXIMUM  TEMPERATURES  , / 

3 23H  PER  MATERIAL  =,  16  / 

4 23H  ANALYSIS  CODE  =,  16  / 

5 23H  CODE  FOR  INCLUSION  , / 

6 23H  OF  BENDING  MODES  =,  16  / 

7 23H  EQ.O,  INCLUDE  , / 

8 23H  GT.O,  SUPPRESS  , ////  IX) 


2002  FORMAT  (8H 1 ELEMENT , 26X , 4HMATL , 5X , 9HREFERENCE , 3X.8H  I -J  FACE.3X, 

1 6HSTRESS,  / 2X,6HNUMBER,5X, 1HI ,5X, 1HJ.5X, 1HK.5X, 1HL.2X, 

2 4HTYPE.3X, 1 1 HTEMPERATURE , 3X , 8HPRESSURE , 3X .6H0PT I ON , 4X , 

3 2HKG.3X.9HTHICKNESS,  / IX) 
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2003  FORMAT  ( 1 8,5 1 6,  F 1 1* . 3,  E 11  . 3.  I 9.  1 6,  F 1 2 .4) 

2004  FORMAT  (///  25H  ELEMENT  LOAD  MULTIPLIERS,  //  10H  LOAD  CASE , 4X , 

1 1 lHTEMPERATURE,3X,8HPRESSURE,3X,9HX-GRAVITY,3Xf 

2 9HY-GRAVITY.3X.9HZ-GRAVITY,  //  5X,  1HA, F 19-3. F 1 1 . 3. 3F 12 . 3 / 

3 5X, 1HB , F 1 9 . 3, F 1 1 .3.3F12.3  / 5X, 1HC.F19.3.F11 .3.3F12.3  / 

4 5X, 1 HD , F 1 9 . 3 , F 1 1 . 3 , 3F 1 2 . 3 ) 

2010  FORMAT  (F 1 2 . 2 , 3E 1 2 . 4 , 3F9 . 4 , E 1 2 . 4 , 3E 1 4 .4) 

2020  FORMAT  (///  25H  MATERIAL  I.D.  NUMBER  =,  15  / 

1 25H  NUMBER  OF  TEMPERATURES  =,  15  / 

2 25H  WEIGHT  DENSITY  =,  E14.4  / 

3 25H  MASS  DENSITY  =,  E14.4  / 

4 25H  BETA  ANGLE  =,  F9.3  // 

5 12H  TEMPERATURE, 8X, 4HE  (N) .8X.4HE  (S) ,8X,4HE  (T) ,3X,6HNU(NS) , 

6 3X,6HNU(NT)  ,3X,6HNU(ST)  ,7X,5HG(NS)  ,6x,8halpha  (N)  ,6x, 

7 8HALPHA  (S)  ,6X,8HALPHA (T)  ) 

END 

SUBROUTINE  PLOAD  (ID.FF, I F F , NUMNP , NEQ, NFN) 

C 

C CALLED  BY?  STEP 

C 

C READ  FORCING  FUNCTION  DATA. 

C TERMINATE  READING  WITH  A ZERO  NODE  NUMBER  ON  INPUT. 

C STORE  FUNCTION  MULTIPLIERS  IN  *FF*  AND  ARRIVAL  TIME  REFERENCES 

C IN  *IFF*. 

C SAVE  FF , IFF  ON  TAPE2  FOR  LATER  USE  IN  LOAD  VECTOR  ASSEMBLY. 

C 

COMMON  /EXTRA/  MODEX , NT8 , I F I LL ( 1 4) 

C 

DIMENSION  I D (NUMNP, 6)  , FF  (NEQ, NFN) .IFF  (NEQ, NFN) 

C 

IF  (MODEX)  10,10,20 
10  REWIND  8 
READ  (8)  ID 
GO  TO  30 
20  REWIND  2 
READ  (2)  ID 
GO  TO  60 
C 

30  NT-2 

REWIND  NT 
C 

DO  50  1-1, NEQ 
DO  50  J- 1 , NFN 
IFF  (I , J) -1 .000 
50  FF  (I , J) -O.ODO 
C 

60  WRITE  (6,2000) 

C 

C CARD  READING  LOOP 
C 

75  READ  (5,1000)  NP, 1C, IFN, IAT.P 
IF  (NP.EQ.O)  GO  TO  200 
IF  (I AT.EQ.O)  IAT-1 
I F (I FN.LT. 1)  I FN  - 1 
WRITE  (6,2002)  NP, 1C, IFN, IAT.P 
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I F (NP.LE.NUMNP)  GO  TO  80 
WRITE  (6,3010)  NP 
STOP 

80  IF  (I C.GT.O  .AND.  IC.LT.7)  GO  TO  82 
WRITE  (6,3020)  1C 
STOP 

82  IF  (IFN.LE.NFN)  GO  TO  84 
WRITE  (6,3030)  IFN 
STOP 

84  CONTINUE 
N=ID  (NP,  1C) 

IF  (N)  100,100,150 
150  I F (MODEX.EQ. 1)  GO  TO  75 
FF (N , I FN) =P 
IFF (N, I FN) = I AT 
GO  TO  75 

100  WRITE  (6,3000)  NP, I C 
STOP 

200  I F (MODEX.EQ. 1)  RETURN 

SAVE  FUNCTION  MULTIPLIERS  AND  ARRIVAL  TIME  REFERENCES 

WRITE  (NT)  FF , IFF 
RETURN 


C 

c FORMATS 

C 


1000  FORMAT 
2000  FORMAT 
1 

2 

3 

2002  FORMAT 
3000  FORMAT 
1 

3010  FORMAT 
3020  FORMAT 
3030  FORMAT 


(36HID  YNAMIC  LOAD  INPUT,//  3X , 4HN0DE , 3* , 
9HDEGREE  OF , 3X.8HFUNCTI ON, 3X, 12HARRI VAL  TIME.5X, 

8HFUNCT ION,/  7H  NUMBER, 5X , 7HFREED0M, 2X , 9HREF ERENCE , 9X , 
6HNUMBER.3X, 1 OHMULT I PL  I ER,  / IX) 

(I  7.7X, 15, 6X, 15, 10X, I 5 . E 1 3 - 4) 

(46H0***  ERROR  LOAD  APPLIED  TO  A CONSTRAINED  DOF,  / 

1 3X , 6HN0DE  (,15,1 4H)  COMPONENT  (J5.1H),  / IX) 

(19H0***  ERROR  NODE  ( , 15,1 5H)  OUT  OF  RANGE.,  / IX) 
(24H0***  ERROR  COMPONENT  (J5.13H)  IS  ILLEGAL.,  / IX) 
(33HO***  ERROR  FUNCTION  REFERENCE  (J5.9H)  IS  BAD.,  / IX) 


C 


END 

SUBROUTINE  POS I NV  (A.NMAX.NDD) 


C 

C CALLED  BY?  ELAW 
C 

DIMENSION  A (NDD.NDD) 


C 


DO  200  N-l.NMAX 


D=A  (N ,N) 

DO  100  J*1 , NMAX 
IF (D.EQ.O.) 0=0.005 
100  A (N, J)  =-A  (N, J) /D 


C 


DO  150  1*1, NMAX 
IF(N-I)  110,150,110 
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110  DO  140  J=1 , NMAX 

IF(N-J)  120,140,120 
120  A (I  , J)=A  (l  , J)+A  (I  ,N)  *A  (N,  J) 

140  CONTINUE 
150  A ( I ,N)-A(I  ,N)/D 
C 

A (N,N) =1 .0/D 
C 

200  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  PPLOT  ( I T, JT, NDS , I SP) 

C 

C CALLED  BY?  DISPLY 
C 

COMMON  / EM  / PP(101)  ,KD(3,8)  ,XM(8)  ,TM(8)  ,IP(8)  ,X(8)  ,IFILL(4856) 
DIMENSION  SM  (8) 

DATA  SM  /1H1 , 1H2, 1H3, 1H4, 1H5, 1H6, 1H7, 1H8  / 

DATA  BL  / 1 H /,V  /1HX/,AST  /1H*/ 

COMMON  / DYN  / NT, NOT, DAMP , DT, I F I LL2  (6) 

C 

c 

READ  (IT)  KD.XM.TM.L 

WRITE  (6,3000)  (KD ( 1 , I ) , KD  (2 , I ) , XM  ( I ) , TM  ( I ) , I , I = 1 , L) 

C 

DO  100  K* 1 , L 
TT  - XM  (K) 

I F (ABS  (TT)  .GT.  1 .0E-8  ) XM  (K)  = 50.0/  TT 
100  CONTINUE 
TT=0 . 

WRITE  (6,999) 

WRITE  (6,1000) 

WRITE  (6,2000)  TT,  (V, 1=1, 101)  ,TT 
C 

K=  1 

DO  200  1=2, 100 
200  PP ( I ) =BL 
C 

DO  500  N= 1 , NDS 
READ  (JT)  X 
PP  (1 ) -V 

pp(5D-v 

PP  (101) -V 

* 

220  I I - 1 SP 

210  IF  (I  I . LE .0)  GO  TO  250 
WRITE  (6,2001)  PP 
I 1 = 1 1-1 
GO  TO  210 

250  TT=TT+DT 

DO  300  1=1 ,L 
XX=XM(I)  *X  (I) 

M=XX 
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M=M+5 1 
I P ( I ) -M 

IF  (PP(M)  .EQ.V  .OR.  PP(M).EQ.BL)  GO  TO  270 
PP  (M)  = AST 
GO  TO  300 
270  PP  (M)  = SM  ( I ) 

300  CONTINUE 

I F (K.LT. 10)  GO  TO  320 
K=1 

WRITE  (6,2000)  TT.PP.TT 
GO  TO  3^0 

320  WRITE  (6,2001)  PP 
K=K+1 
C 

C RESET  PP 
340  DO  360  I =1 , L 
M= I P ( I ) 

360  PP (M) =Bl 
500  CONTINUE 
TT=TT+DT 

WRITE  (6,2000)  TT,  (V.I-1,101) ,TT 
WRITE  (6,1000) 

C 

RETURN 


999  FORMAT  (1H1.57X.15H0  R D I N A T E ) 

1000  FORMAT  ( / 1H  .3X.7HT  I M E.2X.4H-1 .0.21X.4H-0.5.22X, 3H0.0.22X, 
1 3H0.5.22X.3H1 .0.4X.7HT  I M E,  IX) 

2000  FORMAT  (1H  , F 10 .4, 4X, 101 A1 , F 1 2 .4) 

2001  FORMAT  (1H  , 1 4X , 10 1 A 1) 

3000  FORMAT  (18, 12X, 13. 1P2E14.4.3X, 16) 

END 

SUBROUTINE  PRIST  (NS, I SI , I S2 , S I G, SPR) 


C 

C CALLED  BY?  THREED 

DIMENSION  SIG  (12)  ,SPR  (6)  , IS  (2)  ,SG  (6) 

C 

IS  (1)-IS1 
I S (2) -I  S2 
NNS=  1 

IF  (NS.EQ.12)  NNS-2 
DO  900  N-l.NNS 
IN-3*N-3 
I I * I N*2 

IF  (IS  (N)  . EQ.O)  GO  TO  200 
C 

CC-  (SIG  (1  l + l)+SIG(l  l+2))/2. 

BB-  (SIG  (1  1 + 1 ) -SIG  (I  l+2))/2. 

CR=SQRT(BB**2+SIG (I  1+4)  **2) 

SPR  ( I N+l) *CC+CR 
SPR  ( I N+2) *CC-CR 

iPK  ^NE  . 0 .)  SPR  ( I N+3)  *28 .648*ATAN2  (S  I G (I  1+4)  , BB) 
GO  TO  900 
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C 

200  CO(SIG(l  l + O+SIGO  l+2)+SIG(l  l+3))/3. 

DO  210  1-1,3 
SG  (l)-SIG  (I  l + l)  -CC 
210  SG  (1+3)  =S  I G ( I 1 + 1+3) 

C2=  (SG  (1) **2+SG  (2) **2+SG  (3) **2) *.5+SG (4)  **2+SG (5) **2+SG (6) **2 
C3*SG  ( 1 ) * (SG  (2)  *SG  (3)  -SG  (5)  *SG  (3) ) +SG  (4)  * (SG  (5)  *SG  (6)  -SG  (4)  *SG  (3) ) 
1+SG  (6)  * (SG  (4)  *SG  (5)  -SG  (2)  *SG  (6) ) 

T=SQRT(C2/1  .5) 

A=C3*1 .41421 4/T**3 

IF  (ABS(A)  .GT.  1.)  A=S  I GN  ( 1 . , A) 

C***  A=DARCOS  (AJ/3.0D0 

A=ACOS  (A) /3.0D0 
T=T*1 .414214 
SPR  (I N+l ) =T*COS (A) 

SPR  ( I N+2) =T*COS (A+2 . 0944) 

SPR  ( | N+3) =T*COS (A-2 .0944) 

DO  220  1=2,3 

IF  (SPR  ( I N+l) .GT.SPR  (I N+l ) ) GO  TO  220 
C3=SPR(IN+1) 

SPR  ( I N+l ) =SPR  ( I N+ 1 ) 

SPR  (I N+l ) =C3 
220  CONTINUE 

IF  (SPR  ( I N+2)  . LE .SPR  ( I N+3) ) GO  TO  230 
C3=SPR  ( I N+2) 

SPR  ( I N+2) =SPR  ( I N+3) 

SPR  (I  N+3)  =C3 
230  DO  240  1=1,3 
240  SPR  (l  N+l ) =SPR  (I  N+O+CC 
900  CONTINUE 
C 

RETURN 

END 

SUBROUTINE  QDCOS  (N.X.Y.Z.T) 

C 

C CALLED  BY?  STRETR , QTSHEL 
C 

C THIS  SUBROUTINE  COMPUTES  THE  DIRECTION  COSINES  OF  THE  LOCAL 
C ELEMENT  SYSTEM  OF  A QUADRILATERAL  (N=4)  OR  SINGLE  TRIANGLE  (N=1) 

C 

DIMENSION  X ( 1 ) , Y (1)  , Z(l)  , T(l) 

XI  = X (2)  +X  (3)  -X  (N)  -X  (1) 

Y 1 = Y(2)+Y(3)-Y(N)-Y(1) 

Z1  = Z(2)+Z(3)-Z(N)-Z(1) 

X2  = X (3)  +X  (N)  -X  (1)  -X  (2) 

Y2  = Y (3)  +Y  (N)  -Y  (1)  -Y  (2) 

Z2  = Z(3)+Z(N)-Z(1)-Z(2) 

SI  * X1**2+Y1**2+Z1**2 
C = (X1*X2+Y1*Y2+Z1*Z2) /SI 
X2  = X2  - C*X1 
Y2  = Y2  - C*Y 1 
Z2  = Z2  - C*Z1 

51  =SQRT  (SI) 

52  =SQRT  (X2**2+Y2**2+Z2**2) 

XI  = Xl/Sl 
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Y 1 = Y1/S1 

Z1  = Zl/Sl 

X2  = X2/S2 

Y2  = Y2/S2 

Z2  = Z2/S2 

T (1 ) - XI 

T (2)  = X2 

T (3)  = Y1*Z2-Y2*Z1 

T(4)  = Y 1 

T(5)  - Y2 

T (6)  = Z1*X2-Z2*X1 

T(7)  = 

T (8)  = Z2 
T (9)  = X 1 *Y2-X2*Y 1 
RETURN 
END 
C 

C CALLS?  QDCOS,TDCOS,TRFPRD,SLST, LSTSTR, SLCCT , LCTMOM 

C CALLED  BY?  TPLATE 
C 

C THIS  SUBROUTINE  CAN  EVALUATE 

C ...  ELEMENT  STIFFNESS  MATRIX 

C ...  CONSISTENT  NODAL  FORCE  VECTOR  ... 

C ...  INTERNAL  STRESSES  AND  MOMENTS  ... 

C OF  A SHALLOW  QUADRILATERAL  SHELL  ELEMENT  ASSEMBLED  WITH  4 FLAT 
C TRIANGLES,  OR  OF  A SINGLE  TRIANGULAR  SHELL  ELEMENT. 

C 

C 

C**  **********  CALLING  ARGUMENTS  ************** 


INTEGER  FLAG  SPECIFYING  OPERATION  TO  BE  PERFORMED 
IF  KKK  — 1,  FORM  STIFFNESS  MATRIX  ONLY. 

IF  KKK  = 0,  FORM  STIFFNESS  MATRIX  AND  LOAD  VECTOR. 
IF  KKK  = 1,  FORM  LOAD  VECTOR  ONLY. 

IF  KKK  = 2,  EVALUATE  STRESSES  AND  MOMENTS. 

NUMBER  OF  SUPPLIED  NODAL  POINTS 
IF  NNS  * 5,  QTSHEL  FORMS  A QUADRILATERAL,  AND  THE 
PROPERTIES  AT  THE  INTERNAL  NODE  5 MUST  BE  INPUT. 

IF  NNS  « 4,  QTSHEL  FORMS  A QUADRILATERAL,  AND  THE 
PROPERTIES  AT  THE  INTERNAL  NODE  5 ARE  SET  BY  QTSHEL 
TO  BE  THEIR  CORNER  AVERAGE. 

IF  NNS  = 3,  QDSTIF  FORMS  A SINGLE  TRIANGLE. 

NUMBER  OF  GLOBAL  DEGREES  OF  FREEDOM  AT  EACH 
EXTERNAL  NODE  (3,  5 OR  6) 

IF  NPF  - 6,  THE  3 DISPLACEMENTS  U,  V AND  W AND  THE 
3 ROTATIONS  RX,  RY  AND  RZ  ARE  INCLUDED  AS  D.O.F. 

IF  NPF  - 5,  THE  ROTATION  RZ  IS  IGNORED. 

IF  NPF  = 3,  ONLY  U,  V AND  W ARE  CONSIDERED  AND 
THE  BENDING  STIFFNESS  IS  NOT  INCLUDED  (MEMBRANE 
SHELL  ELEMENT) 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


INPUTS 

KKK 


NNS 


NPF 
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C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


MID  NUMBER  OF  INTERNAL  MIDPOINTS  IN  QUADRILATERAL  (0  OR  4) 

IF  MID  = 0,  THE  MEMBRANE  ELEMENTS  ARE  CST 

AND  THE  BENDING  ELEMENTS  ARE  LCCT-9 

IF  MID  = k,  THE  MEMBRANE  ELEMENTS  ARE  LST-10 

AND  THE  BENDING  ELEMENTS  ARE  LCCT-11 

IF  NNS  = 3 (SINGLE  TRIANGLE)  MID  IS  ASSUMED  TO  BE  0 

* 0 1 S INTEGER  FLAG  FOR  THE  NODAL  DISPLACEMENTS  U,V,W 

IF  IDIS  * 0,  U,V,W  ARE  SPECIFIED  IN  THE  GLOBAL  SYSTEM 

IF  IDIS  = 1,  U,V,W  ARE  SPECIFIED  IN  THE  NODAL  DISPL 

SYSTEMS  DEFINED  BY  THE  DIRECTION  COSINE  ARRAY  TD I S . 

IROT  INTEGER  FLAG  FOR  THE  NODAL  ROTATIONS  RX.RY.RZ. 

IF  IROT  = 0,  RX.RY.RZ  ARE  SPECIFIED  IN  GLOBAL  SYSTEM 

IF  IROT  = 1,  RX.RY.RZ  ARE  SPECIFIED  IN  THE  NODAL  ROT 

SYSTEMS  DEFINED  BY  THE  DIRECTION  COSINE  ARRAY  TROT. 

OUTPUTS 

NEF  NUMBER  OF  EXTERNAL  DEGREES  OF  FREEDOM  (NEF  = NPF*NEN, 

WHERE  NEN=4  FOR  QUADRILATERAL,  *3  FOR  SINGLE  TRIANGLE) 

NTF  TOTAL  NUMBER  OF  DEGREES  OF  FREEDOM  (EXTERNAL+ I NTERNAL) 


**********  ARRAYS  IN  COMMON  /QTSARG/  *********** 
X (I) ,Y  (I)  ,Z  (I)  1 = 1. ..NNS  GLOBAL  NODAL  COORDINATES 

CM0,J)  1=1. ..3,  J-1...3  PLANE  STRESS  MATERIAL  MATRIX 

RELATING  STRESSES  TO  STRAINS  IN  THE  LOCAL  SYSTEM 

ALFA (I)  1=1. ..3  DILATATION  COEFFICIENTS  RELATING  IN-PLANE 

THERMAL  STRAINS  IN  THE  LOCAL  SYSTEM  T0  TEMPERATURES 

HM0)  1=1... NNS  THICKNESS  RESISTING  MEMBRANE  STRESSES 

HF>0)  1 = 1. ..NNS  THICKNESS  RESISTING  BENDING  MOMENTS 

RHO  ( 1 . J)  1=1... NNS,  J* 1 ...  3 GLOBAL  COMPONENTS  RHOX  (J=l) , 

RHOY  (J=2)  AND  RHOZ  (J=3)  OF  BODY  FORCES  PER  UNIT 
OF  VOLUME 

HW  ( I ) 1=1... NNS  THICKNESS  FOR  COMPUTING  BODY  FORCES 

RHO*HW  PER  UNIT  OF  ELEMENT  AREA 

P(D  1=1... NNS  LATERAL  PRESSURE  (NORMAL  TO  THE  FACES  OF 

THE  COMPONENT  TRIANGLES) 

T ( I ) 1=1. ..NNS  MEAN  TEMPERATURE  VARIATIONS 

DT  ( I ) 1 = 1. ..NNS  MEAN  TEMPERATURE  THICKNESS  GRADIENTS 

SM(I,J)  1=1. ..NNS,  J=1 . . .3  ARRAY  OF  MEMBRANE  STRESS 

COMPONENTS  IN  THE  LOCAL  SYSTEM  SIG-XX  (J=l) , SIG-YY 
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C 

C 

C 

C 

c 

c 

C BM(I.J) 

C 

c 

c 

c 

c 

c 

c 

C TDIS(I,J,K) 

c 

c 

c 

c 

c 

C TROTd.J.K) 
C 

c 

c 

c 

c 

C S(I,J) 

c 

c 

C S(I,J) 

c 

c 

c 

c 

C R ( I ) 

c 

c 

C R ( I ) 

c 

c 


(J-2)  AND  SIG-XY  (J-3) • SM  CONTAINS 
MEMBRANE  STRESSES  IN  THE  INITIAL  POSITION  AS  INPUT 
WHEN  KKK-0,1,2  (EXCLUDING  THERMAL  ACTIONS) 

MEMBRANE  STRESSES  IN  THE  DEFORMED  POSITION  AS  OUTPUT 
WHEN  KKK-2  (INCLUDING  THERMAL  ACTIONS) 

1 = 1... NNS,  j™ 1 ... 3 ARRAY  OF  BENDING  MOMENT 
COMPONENTS  IN  THE  LOCAL  SYSTEM  MOM-XX  (J=l) , MOM-YY 
(J-2)  AND  MOM-XY  (J-3)*  BM  CONTAINS 
BENDING  MOMENTS  IN  THE  INITIAL  POSITION  AS  INPUTS 
WHEN  KKK=0 ,1,2  (EXCLUDING  THERMAL  ACTIONS) 

BENDING  MOMENTS  IN  THE  DEFORMED  POSITION  AS  OUTPUT 
WHEN  KKK=2  (INCLUDING  THERMAL  ACTION) 

1=1. ..3,  J-1...3.  K-1...NEN  NOT  REQUIRED  IF 
IDIS-O.  IF  IDIS-1,  TDIS(1..3,1.-3.K)  MUST  CONTAIN 
THE  (3,3)  DIRECTION  COSINE  MATRIX  OF  THE  NODAL 
DISPLACEMENT  SYSTEM  AT  THE  K-TH  ELEMENT  NODE  WITH 
RESPECT  TO  THE  GLOBAL  SYSTEM 

1=1. ..3,  J-1...3,  K-1...NEN  NOT  REQUIRED  IF 
I R0T=0 . IF  I ROT- 1 . TROT(l.. 3.1- -3.K)  MUST  CONTAIN 
THE  (3,3)  DIRECTION  COSINE  MATRIX  OF  THE  NODAL 
ROTATION  SYSTEM  AT  THE  K-TH  ELEMENT  NODE  WITH 
RESPECT  TO  THE  GLOBAL  SYSTEM 

1=1. ..NEF,  J-1...NEF  EXTERNAL  STIFFNESS  MATRIX 
(OUTPUT  IF  KKK—1,0) 

1=1. ..NTF,  J-NEF+1 . . .NTF  REDUCED  INTERNAL  STIFFNESS 
OF  QUADRILATERAL  ELEMENT.  OUTPUT  IF  KKK—1,0. 

REQUIRED  INPUT  IF  KKK=1,2.  NOT  USED  FOR  SINGLE 
TRIANGLE. 


1=1... NEF  OUTPUT  EXTERNAL  NODAL  FORCES  IF  KKK-0,1. 
INPUT  EXTERNAL  NODAL  DISPLACEMENTS  IF  KKK-2 . 

I=NEF+1 . . .NTF  REDUCED  INTERNAL  NODAL  FORCE  VECTOR 
OF  QUADRILATERAL  ELEMENT.  OUTPUT  IF  KKK-0,1. 

REQUIRED  INPUT  IF  KKK-2  (RETURNS  INTERNAL  NODAL 
DISPLACEMENTS).  NOT  USED  FOR  SINGLE  TRIANGLE. 


C**********  ROLE  OF 
C 

C ARRAYS  OPERATION 

C 

C 

C X.Y.Z.CM, ALFA, HM, HP  (*) 

C RHO.HW.P 

C T.DT  (*) 

C SM, BM  (*) 

C TD IS, TROT  (*A) 

C S ( 1 . . NEF , 1 . . NEF) 

C S (1 . .NTF , NEF+1 . .NTF) 


ARRAYS  IN  COMMON  /QTSARG/  ******** 

KKK  —1  KKK  = 0 KKK  = 1 KKK  = 2 
QT  QT  QT  QT 


- - ||  II  II 

- - | I I I I/O  I/O 

II  II  II  II 

00  00  - - - - 

0 0 I I 
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C R (1  . .NEF)  - - 00  00  II 

C R (NEF+1 . .NTF)  - - 0 0 - I /O  - 

C 

C WHERE  Q-QUADR I LATERAL  (NNS=lt , 5) , T=S I NGLE  TR I ANGLE  (NNS=3) 

C I * I NPUT , O-OUTPUT,  1/0=1 NPUT/OUTPUT,  -=NOT  USED. 

C 

C NOTES  (*)  HP , DT  AND  BM  ARE  NOT  USED  IF  NPF=3. 

C (**)  TDIS  IS  NOT  USED  IF  IDIS=0,  AND  TROT  IS  NOT  USED 

C I F I ROT-O . 

C 

C 

SUBROUTINE  QTSHEL  (KKK , NNS , NPF ,M I D , I D I S . I ROT, NEF ,NTF) 

COMMON  /QTSARG/  X (5)  ,Y(5)  ,Z(5)  , HM(5),HP(5),  CM  (3, 3)  , ALFA  (3)  , 

1 HW(5),RH0(5.3).P(5).  T(5).DT(5),  SM(5,3),BM(5,3).  TDIS  (36), 

2 TROT  (36) ,S  (30,30)  ,R  (30) 

COMMON  /TRIARG/  A(3),B(3),  HMT  (3)  , HPT  (3)  , C (3.3)  . SMT(3.3), 

) BMT  (3.3)  . FT  (12)  , PI  (3)  ,P2  (3)  ,P3  (3)  ,RM  (3)  , ST  (1  2 , 1 2) 

COMMON. /TRANSF/  T1  (3)  ,T2  (3)  ,T3  (3)  , TO  (3.3) 

COMMON  /EXTRA/  MODEX 

DIMENSION  F (1)  . I PERMQ  (4)  , MFR  (5)  , LOC  (5)  . NC  (3)  , CA  (3)  . WGT  (3)  . 

1 TD1  (13)  .TD2(13)  ,TD3(9)  , TR1  (9)  ,TR2  (9)  ,TR3  (9)  , U (1)  . V (1)  ,W  (1)  , 

2 RX  (I)  ,RY  (1) 

EQUIVALENCE  (T11.T1  (1))  . (T12.T1  (2) ) , (T13.T1  (3) ) . (T2  1 ,T2  (1) ) . 

1 (T22 , T2  (2) ) , (T23,T2(3))  , (T31.T3  0))  . (T32.T3(2))  . (T33.T3(3))  . 

2 (R  (1)  ,F  (1) ) , (U(l)  , FT  (1 ) ) , (V  (1 ) , FT  (7) ) , (W(l)  .PI  (1))  , (RX  (1)  , P2  (1) ) 

3 , (RY  (1)  ,P3  (1) ) 

DATA  I PERMQ  /2.3.4.1/,  MFR  /3,3,3.2,2/,  WGT  /. 50. .50, .25/ 

LOGICAL  QUAD,  TRIG,  NOMP,  NOST,  SIST,  NOLD,  SILD,  NOSM,  SISM,  SKMP 
C 

C INITIALIZE 
C 

SIST  = KKK.LE.O 

NOST  = .NOT. SIST 

SILD  = KKK.EQ.O.OR.KKK.EQ. 1 

NOLD  = .NOT. SILD 

SISM  « KKK.GE.2 

NOSM  = .NOT. SISM 

IF  ( (NNS.NE.3) .AND.  (NNS.NE.5))  NNS  = k 

IF  ((NPF.NE.3)  .AND.  (NPF.NE.6))  NPF  = 5 

NEN  = MINO  (NNS, I*) 

QUAD  = NEN. EQ.4 
TRIG  * NEN.EQ.3 
WG  = 1 . 

N3  - 2*NEN  - 3 

NTR I = 3*NEN  - 8 

NEF  = NEN*NPF 

IF  (MODEX  .EQ.  1)  RETURN 

NSF  = NEF  + (N  EN  — 3) *NPF 

IF  (MID.NE.lt)  MID  = 0 

MIDP  = MID 

IF  (TRIG)  MIDP  = 0 

NFM  = 3 

IF  (NPF.EQ.3)  NFM  = 2 
NTF  = NSF  + NFM*M I DP 
NOMP  = MIDP.LE.O 
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SKMP  = NOMP.OR.NOST 

IF  (NNS.NE.4)  GO  TO  130 

X (5)  = 0.25*(X(1)+X(2)+X(3)+X(4)) 

Y (5)  * 0.25*(Y(1)+Y  (2)+Y  (3)+Y(M) 

Z (5)  * 0.25*(Z(1)+Z(2)+Z(3)+Z(4)) 

HM  (5)  * 0.25*(HM(1)+HM(2)+HM(3)+HM(4)) 

HP  (5)  = 0.25*  (HP  ( 1 ) +HP  (2)  +HP  (3)  +HP  (4)  ) 

IF  (KKK.LT.O)  GO  TO  130 

T(5)  = 0 . 25*  (T  ( 1 ) +T  (2)  +T  (3)  +T  (4)  ) 

DT  (5)  - 0.25*(DT(1)+DT(2)+DT(3)+DT(4)) 

DO  HO  J = 1,3 

SM  (5*  J)  - 0.25*(SM(1,J)+SM(2,J)+SM(3,J)+SM(4,  J)) 

110  BM  (5 , J)  = 0.25*(BM(1  ,J)+BM(2,J)+BM(3,J)+BM(4,J)) 

IF  (NOLD)  GO  TO  130 
P (5)  = o.25*(PO)+P(2)+P(3)+P(M) 

HW  (5)  = 0 . 25*  (HW  (1 ) +HW  (2) +HW  (3) +HW  (4) ) 

DO  120  J - 1,3  % „ .. 

120  RH0(5,J)  = 0 . 25*  (RHO  ( 1 , J) +RHO  (2 , J) +RHO  (3, J) +RHO  (4, J) ) 

130  IF  (NOST)  GO  TO  150 
DO  140  I = l.NTF 
DO  140  J = 1 , NTF 
140  S ( I ,J)  = 0. 

150  IF  (SISM)  GO  TO  170 
DO  160  1=1, NTF 

160  F (I)  = 0. 

170  IF  (NOSM.OR.TRIG)  GO  TO  200 
NEF 1 = NEF  + 1 
DO  180  L = NEF 1 , NTF 
M = L - 1 
DO  180  I = 1 ,M 
180  R (L)  = R(L)  - S(I,L)*R(I) 

200  DO  210  I = 1 ,63 
210  A ( I ) = 0. 

DO  220  I = 1 ,3 

CA  (I ) = CM(1,I)*ALFA(1)+CM(2,I)*ALFA(2)+CM(3,I)*ALFA(3) 

DO  220  J = 1,3 
220  C (I ,J)  = CM  ( I ,J) 

c _ 

C COMPUTE  DIRECTION  COSINE  MATRIX  TO  OF  LOCAL  ELEMENT  SYSTEM 
C 

CALL  QDCOS  (NTRI .X.Y.Z.TO) 

C 

C LOOP  OVER  THE  NTRI  TRIANGLE  COMPONENTS 
C 

DO  700  NT  = 1 , NTR I 
N1  = NT 

N2  = IPERMQ(Nl) 

NC  (1 ) = N 1 

NC  (2)  = N2 

NC  (3)  “ N3 

MT  = MIDP/2 
NOD  = 3 + MT 
C 

C COMPUTE  DIRECTION  COSINES  OF  LOCAL  TRIANGLE  SYSTEM 

C AND  THE  TRIANGLE  PROJECTIONS  A , B ONTO  IT 
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C 

CALL  TDCOS  (N 1 , N2.N3. X , Y, Z, A, B) 

C 

C SET  UP  INPUTS  FOR  TRIANGLE  SUBROUTINES 
C 

DO  240  1-1,3 

L = NC  ( I ) 

LOC  (I)  = NPF*  (L—  1 ) 

HMT(I)  = HM  (L) 

HPT  ( I ) - HP  (L) 

IF  (NOLD)  GO  TO  240 
ROX  * RHO(L.l) 

ROY  * RHO  (L , 2) 

ROZ  - RHO  (L , 3) 

RO 1 * T1 l*ROX+T12*ROY+T13*ROZ 
R02  * T21*R0X+T22*R0Y+T23*R0Z 
R03  = T31*ROX+T32*ROY+T33*ROZ 
HI  - HW  (L) 

PI  (I)  = R01*HI 
P2  (I)  = R02*H1 
P3(D  = R03*H1  + P (L) 

TEMP  - T (L) 

TMOM  = DT(L)*HP(L)**3/12. 

DO  230  J = 1 ,3 

SMT(I.J)  = SM(L.J)  - CA  (J)  *TEMP 
230  BMT(I.J)  = BM(L.J)  - CA  (J)  *TMOM 
240  CONTINUE 
C 

C FORM  TRANSFORMATIONS  BETWEEN  ELEMENT  AND  NODAL  SYSTEMS 
C 

LI  - 9*N1  - 8 
L2  = 9*N2  - 8 

CALL  TRFPRD  ( I D I S , NEN , TD I S (L 1 ) ,TD I S (L2) ,TD I S (1 9) ,TD 1 ,TD2 ,TD3) 
IF  (NPF.NE.3) 

1 CALL  TRFPRD  ( I ROT , NEN , TROT  (L 1 ) , TROT  (L2) .TROT  (1 9) , TR 1 ,TR2 ,TR3) 
DO  250  I = 7,8 
TD  1 (1+3)  - TD1  (I) 

TD  1 (1+5)  - TD  1 (I) 

TD2  (1+3)  = TD2  (I) 

250  TD2  (1+5)  - TD2  ( I ) 

LOC  (4)  = NSF  + NFM*  (N2-1) 

LOC  (5)  - NSF  + NFMA(Nl-l) 

N4  - LOC  (4)  + 3 
N5  - LOC  (5)  + 3 
C 

C MEMBRANE  CONTRIBUTION 

C 

260  IF  (SISM)  GO  TO  320 
C MEMBRANE  STIFFNESS  AND/OR  LOAD  VECTOR 

CALL  SLST  (MT.KKK) 

LT  = 0 

DO  300  JJ  - 1 , NOD 
J * JJ  + JJ 
M = LOC  (JJ) 

LL  = MFR(JJ) 
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CALL  TDCOS  (N1 ,N2,N3, X,Y , Z, A, B) 

SET  UP  INPUTS  FOR  TRIANGLE  SUBROUTINES 

DO  240  1=1,3 

L = NC  ( I ) 

LOC(I)  = NPF*(L-1) 

HMT(I)  = HM(L) 

HPT  ( I ) = HP  (L) 

IF  (NOLD)  GO  TO  240 
ROX  = RHO  (L, 1) 

ROY  = RHO  (L  , 2) 

ROZ  = RHO  (L , 3) 

R01  = T1 l*ROX+T12*ROY+T13*ROZ 
R02  = T21*R0X+T22*R0Y+T23*R0Z 
R03  = T31*ROX+T32*ROY+T33*ROZ 
HI  = HW  (L) 

PI  (I)  = R01*H1 
P 2 ( I ) = R02*H 1 
P3(l)  = R03*H1  + P (L) 

TEMP  = T (L) 

TMOM  = DT(L)  *HP  (L)  **3/12. 

DO  230  J = 1 ,3 

SMT(I.J)  = SM(L.J)  - CA  (J)  *TEMP 
230  BMT  ( I , J)  = BM(L.J)  - CA  (J)  *TMOM 
240  CONTINUE 

C FORM  TRANSFORMATIONS  BETWEEN  ELEMENT  AND  NODAL  SYSTEMS 

C 

Ll  = g*Nl  - 8 
L2  = 9*N2  - 8 

CALL  TRFPRD  (I D I S.NEN.TDI S (Ll) ,TD I S (L2) ,TDIS  (19) ,TD1 ,TD2,TD3) 

1CALL  TRFPRD  ( I ROT.NEN ,TROT  (L 1 ) ,TROT  (L2)  ,TROT  (19)  »TR 1 ,TR2 ,TR3) 

DO  250  I = 7,8 
TD1  (1+3)  = T01  (I) 

TD1  (1+5)  ■ TD1  (I) 

TD2  (1+3)  = TD2  ( I ) 

250  TD2  (1+5)  = TD2  (I) 

LOC  (4)  = NSF  + NFM*(N2-1) 

LOC  (5)  * NSF  + NFM*(N1-1) 

N4  = LOC  (4)  + 3 
N5  = LOC  (5)  + 3 
C 

C MEMBRANE  CONTRIBUTION 

C 

260  IF  (SISM)  GO  TO  320 
C MEMBRANE  STIFFNESS  AND/OR  LOAD  VECTOR 

CALL  SLST  (MT.KKK) 

LT  = 0 

DO  300  JJ  = 1 , NOD 
J = JJ  + JJ 
M = LOC  (JJ) 

LL  = MFR(JJ) 


FILE:  PSAP  FRC  A OLD  DOMINION  UNIVERSITY 


DO  300  L * 1 , LL 
M = M + 1 
LT  = LT  + 1 
Cl  = TD  1 (LT) 

C2  * TD2  (LT) 

IF  (SILD)  F (M)  = F (M)  + FT  (J- 1)  *C  1 + FT(J)*C2 
IF  (NOST)  GO  TO  300 
KT  - 0 

DO  290  II  = 1 , JJ 
1=11+11 
KK  = MFR  (I  I) 

IF  (II .EQ.JJ)  KK  = L 
HI  = ST  (I -1 , J-1) *C1  + ST(I-1,J)*C2 
H2  = ST  (I  ,J-1)*C1  + ST  (I  , J)  *C2 
N = LOC  (I  I) 

DO  290  K = 1 , KK 
N = N + 1 
KT  = KT  + 1 

SQ  = S (N , M)  + TD  1 (KT)  *H  1 + TD2  (KT)  *H2 
S (N , M)  = SQ 
290  S (M, N)  = SQ 
300  CONTINUE 
GO  TO  400 

C MEMBRANE  STRESSES 
320  DO  350  N= 1 , NOD 
L = LOC  (N) 

UE  = R (L+l) 

VE  = R (L+2) 

IF  (N.GT.3)  GO  TO  330 
WE  = R (L+3) 

M3  = 3*N 
M2  = M3- 1 
Ml  = M2- 1 

U (N)  = TD  1 (Ml)  *UE  + TD  1 (M2)  *VE  + TD  1 (M3)  *WE 

V(N)  = TD2  (Ml ) *UE  + TD2  (M2)  *VE  + TD2  (M3)  *WE 

W(N)  = TD3  (Ml ) *UE  + TD3  (M2)  *VE  + TD3(M3)*WE 

GO  TO  350 

330  U (N)  = TD  1 (7)  *UE  + TD  1 (8)  *VE 
V(N)  = TD2  (7)  *UE  + TD2(8)*VE 
350  CONTINUE' 

CALL  LSTSTR  (MT) 

DO  380  1=1,3 
L = NC  (I) 

IF  (QUAD)  WG  = WGT(I) 

TEMP  = T (L) 

DO  380  J-l, 3 

380  SM  (L , J)  = SM(L.J)  + WG*  (SMT  ( I , J)  -CA  (J)  *TEMP) 

400  IF  (NPF.EQ.3)  GO  TO  560 
C 

C PLATE  BENDING  CONTRIBUTION 
C 

IF  (SISM)  GO  TO  600 
BENDING  STIFFNESS  AND/OR  LOAD  VECTOR 
CALL  SLCCT  (MT.KKK) 

DO  500  JJ  = 1 ,3 


C 
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JT  = 3*JJ-3 
J = JT  + 1 
DO  1*50  L = l.NPF 
M = LOC  (J J)  + L 
L3  - L " 3 

IF  (L3.GT.0)  GO  TO  420 
C3  - TD3  (JT+L) 

IF  (SILD)  F (M)  = F (M)  + FT  (J)  *C3 

IF  (SKMP)  GO  TO  450 

54  = S (M, N4)  + ST  (J , 10) *C3 

55  = S(M,N5)  - ST  (J,  1 1)  *C3 
GO  TO  430 

420  Cl  = TR1  (JT+L3) 

C2  = TR2  (JT+L3) 

IF  (SILD)  F (M)  = F (M)  + FT(J+1)*C1  + FT  (J+2)  *C2 

IF  (SKMP)  GO  TO  450 

54  = S(M.N4)  + ST(J+1,10)*C1  + ST  (J+2 , 10) *C2 

55  = S(M,N5)  - ST  (J+l , 1 1)  *C1  - ST  (J+2, 1 1) *C2 

430  S(M,N4)  = S4 

S (N 4 , M)  = S4 
S(M,N5)  = S5 
S(N5,M)  = S5 
450  CONTINUE 

IF  (NOST)  GO  TO  500 
DO  480  I I = 1 , JJ 
IT  = 3*M-3 
I = IT  + 1 
KK  = NPF 

DO  480  L - l.NPF 
IF  (II .EQ.JJ)  KK  = L 
M = LOC  (JJ)  + L 
L3  = L - 3 

IF  (L3.GT.0)  GO  TO  460 
C3  = TP3(JT+L) 

HI  = ST  (I  ,J)*C3 
H2  = ST  (1  + 1 , J) *C3 
H3  = ST  (1+2, J) *C3 
GO  TO  470 

460  Cl  = TR1  (JT+L 3) 

C2  = TR2  (JT+L 3) 

HI  = ST  ( I , J+l) *C1  + ST ( I , J+2) *C2 

H2  = ST  (1  + 1 , J+l) *C1  + ST  (1  + 1 , J+2) *C2 

H3  -=  ST  (1+2,  J+l)  *C1  + ST  (1+2,  J+2)  *C2 

470  N * LOC (I  I) 

DO  480  K * 1 , KK 
N = N + 1 

K3  - K - 3 

K1  = IT  + K 
K2  * IT  + K3 

IF  (K3.LE.0)  SQ  - S(N,M)  + TD3  (K 1 ) *H  1 
IF  (K3.GT.0)  SQ  * S(N,M)  + TR1  (K2)*H2  + TR2(K2)*H3 
S(N,M)  = SQ 
480  S (M, N)  = SQ 
500  CONTINUE 

IF  (NOMP)  GO  TO  700 
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IF  (NOLD)  GO  TO  540 
F (Ni<)  = F (N4)  + FT  (10) 

F (N5)  - F (N5)  - FT  (11) 

5^0  IF  (NOST)  GO  TO  700 

S (Nit, Nit)  * S (Nit, Nit)  + ST  (10,  10) 

S(N5,N5)  - S(N5,N5)  + ST(ll.ll) 

S(N4,N5)  = S(N4,N5)  - ST  (10,  1 1) 

S(N5,N4)  = S (Nit, N5) 

GO  TO  700 

560  IF  (NOLD)  GO  TO  700 

FL  - (P3(D+P3(2)+P3(3))*(A(3)*B(2)-A(2)*B(3))/12. 

JT  = 0 

DO  580  JJ  = 1,2 
DO  580  L=1 , 3 
JT-JT+1 

M = LOC (JJ)  + L 
580  F (M)  * F (M)  + FL*TD3(JT) 

GO  TO  700 

C BENDING  MOMENTS 
600  DO  650  N-l ,3 
L = LOC  (N) 

M3  = 3*n 
M2  « M3- 1 
Ml  = M2- 1 
XE  = R (L+4) 

YE  * R (L+5) 

ZE  = 0.0 

IF  (NPF.EQ.6)  ZE  = R(L+6) 

RX  (N)  = TR1  (Ml) *XE  + TR1  (M2) *YE  + TR1  (M3) *ZE 
650  RY(N)  = TR2(M1)*XE  + TR2  (M2) *YE  + TR2  (M3)  *ZE 
RM  (1)  = R (Nit) 

RM  (2)  --R  (N5) 

CALL  LCTMOM  (MT) 

DO  680  1-1,3 
L = NC  (I) 

IF  (QUAD)  WG  - WGT(I) 

TMOM  * DT(L)*HP(L)**3/12.0 
DO  680  J-1,3 

680  BM(L,J)  = BM(L,J)  + WG*  (BMT  (I  , J) -CA  (J)  *TMOM) 

700  CONTINUE 

I F (SISM.OR.TRIG)  GO  TO  900 
C 

C CHECK  FOR  POSSIBLE  INTERNAL  STIFFNESS  SINGULARITY  (FLAT 

C OR  NEARLY  FLAT  QUADRILATERAL  WHEN  NPF  - 3 OR  6) 

C 

IF  ((NPF. EQ. 5) -OR. NOST)  GO  TO  730 

DO  720  N - 3.6,3 

IF  (NPF.NE.N)  GO  TO  720 

M - 5*N 

Ml  = M - 1 

M2  - M - 2 

IF  (S  (M,M)  .GT. (S (Ml ,M1)+S (M2.M2)) *1 .0E-08)  GO  TO  720 
DO  710  I - l.NTF 
S (I  ,M)  = 0. 

710  S (M, I)  - 0. 
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720  CONTINUE 
C 

C CONDENSATION  OF  INTERNAL  DEGREES  OF  FREEDOM 
C 

730  NIF  = NTF  - NEF 
DO  800  N = 1 ,N I F 
K = NTF  - N 


L = K + 1 
PIVOT  = S (L.L) 

FL  = F (L) 

IF  (PIVOT. LE.O.)  GO  TO  800 
F (L)  = F(L) /PIVOT 
DO  780  I = 1 ,K 
G = S ( I , L) 

IF  (G)  740,780,740 

7U0  IF  (NOST)  GO  TO  770 
G = G/PIVOT 
S (I  ,L)  = G 
DO  760  J = I ,K 
SQ  = S (I  ,J)  - G*S  (L , J) 

S (I  ,J)  = SQ 
760  S (J,  I)  = SQ 
770  F (I)  = F (I)  - G*FL 
780  CONTINUE 
800  CONTINUE 
900  RETURN 
END 

SUBROUTINE  QUAD  (B,BB) 


C 

C 

c 

c 


CALLS?  FORMB, VECTOR 
CALLED  BY?  PLNAX 


COMMON  /ELPAR/  NPAR  ( 1 4) , NUMNP,MBAND,NELTYP,N1 ,N2,N3,N4,N5.MT0T,NEQ 
COMMON  /EM/  LM  ( 1 2)  ,S  (12,  12)  ,P  (12,4)  ,XM(12)  , 

1 T I (20,4)  , I X (4)  , I E (5)  ,NS,D  (4,4)  ,EMUL(4,5)  .RR(4)  ,ZZ(4)  ,H(6)  ,HS(6)  , 

2 HT(6)  ,HR(6)  ,HZ  (6)  , FAC, XMM, PRESS,  EE  (10)  ,TT I (4)  , PP  (1  2 , 4)  ,TH  I CK 

3 ,TMP  (4)  ,TP  (12)  ,ALP(4)  ,IFILL2  (4236) 

COMMON  /JUNK/  MAT , NT , TEMP . REFT , BETA , I F I LL 1 (422) 

DIMENSION  B (20 , 1 2)  , BB  (20 , 1 2)  r ...  w . 

DIMENSION  SS  (2)  ,TT  (2)  ,HH(2)  ,SSS(5)  ,TTT(5)  . IVECT(4)  ,JVECT(4)  ,V(4) 
DATA  SSS/O. ,-l . , 1 . ,0. ,0./,  TTT/O. ,0. ,0. ,-l . , 1 J 
DATA  SS/-0. 577350269 18963. 0.577350269 18963/ 

DATA  TT/-0. 577350269 18963, 0.577350269 18963/ 

DATA  HH/1 .,!./,  I VECT/4, 2, 1 , 3/.  JVECT/1 ,3.2,4/ 


C 

DO  170  J=1 , 12 
XM  (J) *0.0 
TP  (J)  * 0.0 
DO  160  1-1,20 
BB  (I  , J)  =0.0 
160  B (I  , J)  =0.0 
DO  170  1=1,12 
170  S (I ,J)=0.0 
C 

DO  500  11=1,2 
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DO  500  JJ-1,2 

CALL  FORMB  (SS  ( I I)  ,SS  (JJ)  , B) 

TEMP  =0.0 
DO  200  1=1,4 

200  TEMP  = TEMP  + H (I ) * TMP  ( I ) 

FAC=FAC*HH  (JJ) *HH  (I  I) 

FTP  = TEMP  - REFT 
DO  400  J-1,12 

D 1 = (0  ( 1 , 1 ) *B  ( 1 , J)  +D  ( 1 , 2)  *B  (2 , J)  +D  ( 1 , 3)  *B  (3 . J)  +D  (1 , 4)  *B  (4 , J) ) *F  AC 

D2=  (D  (2,  1)  *B  (1  , J)+D  (2,2)  *B  (2,  J)+D  (2,3)  *B  (3,J)+D  (2,4)  *B  (4,  J) ) *F  AC 

D3=(D(3,  1)  *B  ( 1 , J)  +D  (3, 2)  *B  (2 , J)  +D  (3,3)  *B  (3,  J)+D  (3,4)  *B  (4,  J) ) *FAC 

D4=  (D  (4,  1)  *B  (1 , J)+D  (4,2)  *B  (2,  J)+D  (4,3)  *B(3,J)+D  (4,4)  *B  (4 , J) ) *f AC 

TP  (J)  » TP  (J)  + FTP*  (D 1 *ALP  ( 1 ) +D2*ALP(2)  + D3*ALP(3)  + D4*ALP  (4) ) 
DO  400  I =J , 1 2 

S ( I , J) =S  ( I . J) +B  ( 1 , I ) *0 1+B  (2 , I ) *D2+B  (3 , I ) *D3+B  (4,1) *D4 
400  S (J,  l)=S  (I  , J) 

DO  450  1=1,4 
450  XM(I)=XM(I)+FAC*H(I) 

500  CONTINUE 
C 

C FORM  STRESS  D I SDLACEMENT  MATRIX 
C 

LL=NS/4 
DO  530  L= 1 , LL 

CALL  FORMB  (SSS  (L)  ,TTT(L)  ,BB) 

C 

TEMP  = 0.0 
DO  515  K-1,4 

515  TEMP  = TEMP  + H (K) * TMP  (K) 

FAC  = TEMP  - REFT 
DO  530  11=1,4 
1 = 1 1+4*  (L  — 1 ) 

T I (I  ,4)  = -TTI  (I  I)*  FAC 
DO  530  J-1,12 
B (I  , J)  =0.0 
DO  530  K-1,4 

530  B ( I , J)  =B  ( I , J)  +D  ( I I , K)  *BB  (K , J) 

C 

C ELIMINATE  EXTRA  DEGREES  OF  FREEDOM 
C 

IF  ( IX  (3)  .EQ. IX  (4)  ) GO  TO  5&0 

I F ( NPAR  (6)  .NE .0  ) GO  TO  56O 

DO  550  NN-1,4 

L-12-NN 

K-L+l 

C = TP(K)/S(K,K) 

DO  535  J-1.NS 

535  T I (J , 4)  = T I (J , 4)  + C*  B (J , K) 

DO  550  I = 1 , L 
C*S(I,K)/S(K,K) 

TP  ( I ) = TP  ( I ) - C*  TP(K) 

DO  5^0  J=1 ,NS 
540  B (J , I ) =B  ( J , I ) -C*B  (J , K) 

DO  550  J= 1 , L 

550  S (I  ,J)=S  (I  , J)  -C*S  (K , J) 
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C 

C ROTATE  STRESS-DISPLACEMENT  TRANSFORMATION  TO  GIVE  STRESSES 

C NORMAL  AND  PARALLEL  TO  SIDES.  SIMILARLY,  ROTATE  INITIAL  STRESSES. 

C 

560  NSET  = LL-1 

I F ( NSET.LE.O  ) GO  TO  730 
DO  720  L=1 , NSET 
IV  = IVECT(L) 

JV  = JVECT(L) 

CALL  VECTOR  (V, RR  ( I V)  , ZZ  ( I V)  , 0 .0 , RR  (JV)  , ZZ  (JV)  ,0 .0) 

S2  = V(1)*V(1) 

C2  = V(2)*V(2) 

SC  =-V  (1)  *V  (2) 

I 1 = 4*L+1 
12=  11+1 
I 4 = 11+3 
T1  = T I (11,4) 

T2  = Tl  (12,4) 

T 4 = Tl  (14, 4) 

T5  = 2 ,0*SC*T4 

Tl  (I  1 ,4)  = C2*T1+S2*T2+T5 

Tl  (12,4)  = S2*T1+C2*T2-T5 

T I (14,4)  = SC*  (T2-T1)  + (C2-S2) *T4 

DO  710  J=1 ,8 

B 1 = B (I  1 , J) 

B2  = B ( I 2 , J) 

B4  = B ( I 4 , J) 

B5  = 2.0*SC*B4 
B (I  1 , J)  = C2*B1+S2*B2+B5 
B ( I 2 , J)  = S2*B1+C2*B2-B5 
710  B ( I 4 , J)  = SC*  (B2-BD  + (C2-S2)  *B4 
720  CONTINUE 
730  CONTINUE 
C 

DO  660  L=1 ,4 
DO  600  1=1 , NS 

600  Tl  (I  ,L)  = Tl  (I  ,4)*  EMUL(L.l) 

DO  660  1=1,8 

660  P (I  , L)  = TP(0*  EMUL(L.l) 

C 

C CALCULATE  PRESSURE  LOADS  ON  I -J  FACE 
C 

DR=RR  (2)  -RR  (1) 

DZ=ZZ  (1)  -ZZ  (2) 

R I =PRESS*  (2 . *RR  ( 1 ) +RR  (2) ) /6 . 

RJ=PRESS*  (2  . *RR  (2)  +RR  (1 ) ) /6 . 

IF  (NPAR(5)  • EQ.O)  GO  TO  670 
R I =PRESS*TH I CK/2 . 

RJ=R  I 

670  DO  700  L=1 , 4 

P (1  ,L)=P  (1  ,L)+DZ*RI*EMUL  (L,2) 

P (5,L)  =P  (5,  L)  +DR*R I *EMUL  (L,2) 

P (2 , L)  =P  (2 , L)  +DZ*RJ*EMUL  (L , 2) 

700  P (6 , L)  =P  (6 , L)  +DR*RJ*EMUL  (L , 2) 

RETURN 
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END 

SUBROUTINE  REDBAK  (A,VA,VV,MAXA,NEQB,NV,NWA,NWV,NWVV,NTB,NBLOCK, 
1 M I ,MA) 

C 

C CALLED  BY?  SSPCEB 
C 

COMMON  /TAPES/NST I F , NRED , NL , NR, NT, NMASS 
D I MENS  I ON  A (NWA)  , VA  (NWV)  , VV  (NWVV)  , MAXA  (M I ) 

C 

I NC=NEQB  - 1 
NEB=NTB*NEQB 
NEBT=NEB+NEQB 
C 

C REDUCE  VECTORS  ON  TAPE  NR 
REWIND  NRED 
REWIND  NR 
REWIND  NL 
REWIND  NT 

READ  (NRED)  A, MAXA 
I SV=NTB+1 

IF  (NBLOCK.EQ. 1)  ISV-1 
LL=0 

DO  10  L»1 , ISV 
READ  (NR)  VA 
K=0 
KK=LL 

DO  20  J=1 , NV 
DO  30  1=1 , NEQB 
K=K+1 
KK=KK+1 

30  VV  (KK)  =VA  (K) 

20  KK=KK+NEB 

10  LL=LL+NEQB 

I SA=1 
C 

500  DO  100  N=2,NEQB 
KL=N  + INC 
KU=MAXA (N) 

IF  (KU-KL)  100,110,110 
110  K=N 

DO  120  L= 1 , NV 
KJ=K 

DO  130  KK-KL.KU, INC 
KJ-KJ  - 1 

130  VV(K)-VV(K)  - A (KK)  *VV  (KJ) 

120  K=K  + NEBT 

100  CONTINUE 

135  KL-NEQB 

ML=NEQB  + 1 
DO  HO  N=ML,MI 
KL=KL  + NEQB 
KU=MAXA  (N) 

IF  (KU-KL)  HO,  150,  150 
K=NEQB 
KN=N 


150 
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DO  160  L=  1 , NV 
KJ=K 

DO  170  KK=KL , KU , INC 

VV (KN)  =VV  (KN)  - A (KK) *VV  (KJ) 

170  KJ=KJ  - 1 
K=K  + NEBT 
160  KN=KN  + NEBT 
140  CONTINUE 
C 

DO  200  1=1, NEQB 
C=A  ( I ) 

IF  (C)  180,200,180 
180  KK= I 

DO  210  L= 1 , NV 
VV(KK)=VV(KK)/C 
210  KK=KK+NEBT 
200  CONTINUE 

IF  (I SA.EQ.NBLOCK)  GO  TO  400 
READ  (NRED)  A,MAXA 
I SA= I SA+1 
C 

C STORE  REDUCED  VECTORS  ON  TAPE  NT 
K=0 
KK=0 

DO  240  J=1 , NV 
DO  220  1=1 , NEQB 
K=K+1 
KK=KK+1 

220  VA (K)  =VV  (KK) 

240  KK=KK+NEB 

WRITE  (NT)  VA 
K=  1 

DO  310  J=1 ,NV 
DO  300  1=1, NEB 
VV (K)  =VV (K+NEQB) 

300  K=K+1 

310  K=K+NEQB 

IF  (I SV. EQ.NBLOCK)  GO  TO  500 

READ  (NR)  VA 

I SV= I SV+1 

KK=NEB 

K=0 

DO  330  J=1 , NV 
DO  320  1=1 ,NEQB 
K=K+1 
KK-KK+1 

320  VV (KK) =VA  (K) 

330  KK=KK+NEB 
GO  TO  500 
C 

C BACKSUBSTITUTE  VECTORS  ON  TAPE  NT 
400  BACKSPACE  NRED 
I SA=1 

420  ML=NEQB+1 
KL=NEQB 
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DO  600  M-ML.MI 
Kl.-KL+NEQB 
KU=MAXA (M) 

IF  (KU-KL)  600,610,610 
610  K=NEQB 
KM=M 

DO  630  L= 1 , NV 
KJ-K 

DO  620  KK=KL,KU, INC 
VV  (KJ)  =VV  (KJ)  - A (KK)  *VV  (KM) 
620  KJ-KJ  - 1 

KM=KM  + NEBT 
630  K=K  + NEBT 
600  CONTINUE 
N=NEQB 

DO  61*0  LJ-2.NEQB 
KL=N  + INC 
KU-MAXA  (N) 

IF  (KU-KL)  640,650,650 
650  K=N 

DO  680  L= 1 , NV 
K J=K 

DO  690  KK-KL , KU, I NC 
KJ-KJ  - 1 

690  VV  (KJ)  =VV  (KJ)  - A (KK)  *VV  (K) 
680  K-K  + NEBT 

640  N-N  - 1 

665  KK=0 
K-0 

DO  660  J-l.NV 
DO  670  I = 1 , NEQB 
K=K+ 1 
KK-KK+1 

670  VA  (K)  =VV  (KK) 

660  KK-KK+NEB 

WRITE  (NL)  VA 

IF  (I SA.EQ.NBLOCK)  GO  TO  800 

BACKSPACE  NRED 

READ  (NRED)  A.MAXA 

BACKSPACE  NRED 

ISA-ISA+1 

BACKSPACE  NT 

READ  (NT)  VA 

BACKSPACE  NT 

K-NEBT 

DO  700  J-l.NV 
DO  720  1-1, NEB 
VV  (K)  -VV  (K-NEQB) 

720  K-K-l 
700  K-K+NEBT+NEB 
K-0 
KK-0 

DO  IkO  J-l.NV 
DO  760  1-1, NEQB 
K-K+l 
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KK=KK+1 

760  VV  (KK)  =VA  (K) 

740  KK=KK+NEB 
GO  TO  420 
800  RETURN 

SUBROUTINE  REDVK  (A, VV, MAXA , NEQB , NWA , NEQ.NBLOCK ,MI ,MA , NCALL) 

C 

C CALLED  BY?  SOLSTP 

C THIS  ROUTINE  REDUCES  AND  BACK-SUBSTITUTES  A SINGLE  VECTOR  STORED 
C IN  CORE  USING  A REDUCED  MATRIX  STORED  IN  BLOCK  FORM. 

C 

D I MENS  ION  A (NWA)  , VV  (NEQ)  , MAXA  (Ml ) 

C 

COMMON  /TAPES/  NSTIF.NRED.NL.NR, I F ILL  (2) 

C 

I NC=NEQB  - 1 
MAI  = MA-1 
C 

C PERFORM  FORWARD  REDUCTION  OF  THE  VECTOR 

C „ 

I F (NBLOCK.EQ. 1 .AND.  NCALL. GT.l)  GO  TO  22 

REWIND  NRED 
READ  (NRED)  A, MAXA 
22  ISA  = 1 
KSTART  = 2 
KEND  = NEQB 
C 

500  N = 1 

DO  100  K=KSTART,KEND 
N = N+l 
KL=N  + INC 
KU=MAXA  (N) 

IF  (KU-KL)  100,110,110 
110  KJ  = K 

DO  130  KK=KL, KU, INC 
K J=K J - 1 

130  VV  (K)  =VV  (K)  - A (KK)  *VV  (KJ) 

100  CONTINUE 
C 

I F (I SA.EQ.NBLOCK)  GO  TO  175 
KL  « NEQB 
ML  * KEND+1 

MR  - Ml  NO  (KEND+MA 1 ,NEQ) 

N = NEQB 
DO  140  K-ML.MR 
N = N+l 
KL=KL  + NEQB 
KU-MAXA  (N) 

IF  (KU-KL)  140,150,150 
150  KJ  = KEND 

DO  170  KK=KL,KU, INC 
VV  (K)  = VV  (K)  - A (KK)  *VV  (KJ) 

170  KJ=KJ  - 1 
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11*0  CONTINUE 
C 

175  KST  = KSTART-1 
N = 0 

DO  200  K-KST.KEND 
N = N+1 
C = A (N) 

IF  (C)  180,200,180 
180  VV  (K)  = VV(K)/C 
200  CONTINUE 

205  IF  (ISA.EQ.NBLOCK)  GO  TO  1*00 
READ  (NRED)  A.MAXA 
I SA= I SA+1 

KSTART  = KSTART+NEQB 
KEND  = Ml  NO (KEND+NEQB,NEQ) 

C 

GO  TO  500 
C 

C BACK-SUBSTITUTE  REDUCED  VECTOR  (STORED  IN  CORE) 
C 

1*00  I F (ISA.  GT  - 1 ) 

^BACKSPACE  NRED 
I SA=  1 

NN  = NEQ-  (NBLOCK-1) *NEQB 
KEND  = NEQ 
GO  TO  61*5 
C 

1*20  KEND  * KEND-NN 
NN  * NEQB 
C 

KL=NEQ8 

MR  = MINO(NEQ,KEN  D+MA 1 ) 

ML  = KEND+1 
N = NEQB 
DO  600  K=ML ,MR 
N = N+1 
KL=KL+NEQB 
KU-MAXA  (N) 

IF  (KU-KL)  600,610,610 
610  KJ  * KEND 

DO  620  KK-KL.KU, INC 

VV  (KJ)  *VV  (KJ)  - A (KK)  *VV  (K) 

620  KJ-KJ  - 1 
600  CONTINUE 
C 

61*5  N - NN 
K - KEND 
DO  640  L-2.NN 
KL«N  + INC 
KU-MAXA  (N) 

IF  (KU-KL)  655.650,650 
650  KJ*K 

DO  690  KK-KL.KU, INC 
KJ=KJ  - 1 

VV (KJ)  =VV  (KJ)  - A (KK)  *VV  (K) 


690 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


655  N=N  - 1 
640  K = K-l 

IF  (ISA. EQ.NBLOCK)  GO  TO  800 

BACKSPACE  NRED 
READ  (NRED)  A.MAXA 
BACKSPACE  NRED 
I SA= I SA+1 


C 


800 


c 

c 

c 

c 

c 


c 


GO  TO  420 

RETURN 

END 

SUBROUTINE  RESPEC 
REAL  T (4) 

CALLS?  EMI DR.SPECTR.PRI NTD.STRESR 
CALLED  BY?  MAIN 


COMMON  /SOL/  NBLOCK.NEQB, LL.NF , I F I LL1  (7) 
COMMON  /JUNK/  XXX  (4)  , NDYN , JUK  (42 1 ) 

COMMON  /ELPAR/  NPAR  ( 1 4)  , NUMNP , MBAND , NELTYP , 
COMMON  /EXTRA/  MODEX , NT8 , I F I LL2  ( 1 4) 


NT 


COMMON  /one/  A(l) 


C 

c 

WRITE  (6,1010) 

XXX  (4)  =0. 

C***  CALL  TTIME  (T  ( 1 ) ) 

I F (MODEX. EQ. 1)  GO  TO  100 
N2=N 1 + 6*NUMNP 

CALL  EMI  DR  (A  (N 1)  , A (N2)  , NUMNP , NEQB) 


C 

C 


100  N2*N1+NEQB*NF 
N3=N2+NF*3 
N4-N3+NEQB 
N5=N4+NF 
N6=N5+NEQB 
N7-N6+NF 
MM-N7-MT0T 
IF  (MM.GT.O) 
CALL  SPECTR 


CALL  ERROR  (MM) 

(A  (N1)  , A(N2)  ,A(N3)  ,A(N4)  ,A(N5) 


C MODE  SHAPE  NG  IS  R.M.S.  DISPLACEMENT 
C 

C***  CALL  TTIME  (T  (2) ) 

IF  (MODEX. EQ.l)  GO  TO  200 

N2=N1+6*NUMNP 

NG=NF+1 

N3-N2+6*NG 

N4«N3+NEQB*NG 

MM=N4-MT0T 


N2,N3,N4,N5,MT0T,NEQ 


NEQB.NF .NBLOCK, A (N6) ) 
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IF  (MM.GT.O)  CALL  ERROR  (MM) 

NT=2 

c CALL  PR 1 NTD  (A  (N 1 ) ,A(N2)  ,A(N3)  ,NEQB,NUMNP,NG,NBLOCK,NEQ,NT,  3) 

C COMPUTE  STRESSES 
C 

c***  200  CALL  TTIME  (T  (3) ) 1200  IS  TRANSFERED  TO  THE  NEXT  LINE 

200  NSB=NBLOCK*NEQB 
N2=N 1+1 2*NF 
N3=N2+NSB*NF 
N^=N3+12 
MM=Ni+-MTOT 

IF  (MM.GT.O)  CALL  ERROR (MM) 

C 

CALL  STRESR  (A  (N 1 ) , A (N2)  , A (N 3) , NF , NSB , NEQB, NBLOCK) 

C**ft  CALL  TTIME  (T  (4) ) 

C 

TT-O. 

DO  10  1=1,3 
T(I)=T(I  + 1)-T(I) 

10  TT=TT+T ( I ) 

T (4)  =TT 

WRITE  (6,1000)  (T  ( I ) , 1 = 1 ,4) 

RETURN 

C 

1000  FORMAT  (27H1R.  M.  S.  TIME  LOG,/ 

1 5X, 37HCOMPUTE  MAXIMUM  NODAL  DISPLACEMENTS  =,  F8.2  / 

2 5X.37H0UTPUT  MAXIMUM  NODAL  DISPLACEMENTS  =,  F8.2  / 

3 5X.37HCOMPUTE  ELEMENT  STRESSES  F8.2  // 

4 5X , 37HTOTAL  FOR  SPECTRUM  ANALYSIS  =,  F8.2  ) 

1010  FORMAT  (lHl,//3lfH  RESPONSE  SPECTRUM,  3X, 

1 1 5HA  N A L Y S I S,  //  IX) 

END 

SUBROUTINE  RESPON  (W, P, X, NF , NT, NDS) 

C 

C CALLED  BY?  H I STRY 

REAL  KAP 
C 

DIMENSION  W(NF)  ,P(NT)  ,X(NF,NDS) 

COMMON  /DYN/  MT, NOT , XS I , DT, I F I LL2 (6) 

COMMON  /JUNK/  BET, KAP, A (3,3) ,B  (3) ,U  (3) ,U0  (3) , I F I LL1  (390) 

C EVALUATION  OF  NORMAL  RESPONSE 

C 

REWIND  7 
REWIND  If 
READ  (7)  W 
TH=  1 .It 
C 

DO  260  N=1 ,NF 
READ  (4)  P 
K=  1 

NOUT=NOT+ 1 

BET  = 1.  / (TH/(W(N)*W(N)*DT*DT)  + XS  I *TH*TH/  (W  (N)  *DT)  + TH*TH*TH/ 

16  ) 
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230 


KAP=XS  I *BET/  (W  (N)*DT) 

A (i , 1 ) =1 . - BET *TH*TH/3 • " 1 */TH  - KAP*TH 
A(2,1)-DT*(1.  - l./(2.*TH)  - BET*TH*TH/6.  - KAP*TH/2.) 

A (3, l) =dt*dt*  (0.5  - l./(6.*TH)  - BET*TH*TH/18.  - kap*th/6.) 
A (1 ,2)  = (-BET*TH  - 2.*KAP)/DT 
A (2 , 2) =1 • - BET *TH/2 . - KAP 
A(3,2)-DT*(1.  “ BET*TH/6.  - KAP/3 •) 

A (1,3) —BET/  (DT*DT) 

A(2,3)=-BET/(2.*DT) 

A (3. 3) =1 • - BET/6. 

B (1)  =BET/  (W  (N)  *W  (N)  *DT *DT) 

B (2)  =BET/  (2  . *W  (N)  *W  (N)  *DT) 

B (3)  =BET/  (6 . *W  (N)  *W  (N) ) 

DO  230  J-1.3 
UO  (J)  =0. 

U (J)  =0. 

UO  (1)=P  0) 


DO  260  1=2, NT 
DO  2*40  L-1,3 
U (L)  =B  (L)  *P  ( I ) 

DO  240  LL=1 ,3 

240  U(L)=U(L)  + A (L,  LL)  *U0  (LL) 
DO  245  L=1 , 3 
245  UO  (L)  =U  (L) 

IF(NOUT-I)  260,250,260 
250  X (N , K)  =U  (3) 

K=K+1 

NOUT=NOUT+NOT 
260  CONTINUE 


C 

C 


C 

C 

C 


260 


REWIND  4 
WRITE  (4)  X 

RETURN 

SUBROUTINE  S BLOCK  (VOLD, VNEW,XM,NFO,NV,NEQBO,NEQB,NBLOKO,N BLOCK) 

CALLED  BY?  MODES 

COMMON  /TAPES/  NSTI  F ,NRED,NL,NR,NT ,NMASS 
DIMENSION  VOLD (NEQBO.NFO)  ,VNEW (NEQB.NV)  .XM(NEQB) 

READ  (10)  (VOLD (1 , I) , 1*1 ,NFO) 

DO  260  L=1 .NBLOKO 
READ  (10)  VOLD 
CONTINUE 
LBL0K0=1 
LBLOCK-O 


1=0 

K=0 

REWIND  NMASS 
READ  (NMASS) 


XM 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


REWIND  NT 
BACKSPACE  10 
C 

GO  TO  240 
C 

200  K=K+1 
1 = 1 + 1 
XMM=XM  ( I ) 

DO  100  J=1 ,NFO 
100  VNEW  ( I , J) =V0LD (K , J) *XMM 
C 

IF  (K . LT.NEQBO)  GO  TO  120 
K=0 

LBLOKO=LBLOKO+ 1 

IF  (LBLOKO-NBLOKO)  140,140,160 
C 
C 

140  BACKSPACE  10 
READ  (10)  VOLD 
BACKSPACE  10 
C 

120  IF  (I . LT.NEQB)  GO  TO  200 
1=0 
c 

1 60  LBL0CK=LBL0CK+1 
C 

WRITE  (NT)  VNEW 
C 

IF  (LBLOCK . EQ.NBLOCK)  RETURN 
READ  (NMASS)  XM 
240  DO  220  L I = 1 ,NEQB 
DO  220  LJ-1 , NV 
220  VNEW  (L I , LJ) =0.0 
C 

GO  TO  200 
C 

END 

SUBROUTINE  SCHECK  (DL,RTOLV,A,XM,BUP,BLO,BUPC,NEIV,NWA,NEQB, 
1NBL0CK,NF,NV,SHIFT,NEI , IFPR.RTOL) 

C 

C CALLED  BY?  SSPCEB 
C 

COMMON  /TAPES/NST I F , NRE D , NL , NR , NT , NMASS 

DIMENSION  A(NWA)  .XM(NEQB)  ,BUP(NV)  ,BLO(NV)  ,BUPC(NV)  ,DL(NV)  , 
IRTOLV(NV) 

INTEGER  NE I V (NV) 

C 

FT0L=l.OE-O2 

C 

DO  100  1=1, NV 

BUP  ( I ) =DL  (I ) * (1  .O+FTOL) 

100  BL0(I)=DL(I)*(1.0-FT0L) 

NR00T=O 
DO  120  1=1, NF 

120  IF  (RTOLV  ( I ) . LT.RTOL)  NROOT-NROOT+1 
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IF  (NROOT.GE.  1)  GO  TO  200 
WRITE  (6,1010) 

STOP 

C 

C FIND  UPPER  BOUNDS  ON  EIGENVALUE  CLUSTERS 
200  DO  240  1=1, NROOT 

240  NE I V ( I ) = 1 

IF  (NROOT. NE.l)  GO  TO  260 
BUPC(1)-BUP(1) 

LM*1 
L=  1 
1=2 

GO  TO  295 
260  L=1 

1=2 

270  IF  (BUP  (1-1)  .LE.BLO(I))  GO  TO  280 
NE  I V (L)  =NE  I V (L)  +1 
1 = 1 + 1 

I F (I  .LE. NROOT)  GO  TO  270 
280  BUPC  (L) =BUP  ( I “ 1 ) 

IF  (I .GT. NROOT)  GO  TO  290 
L = L+1 
1 = 1 + 1 

I F (I .LE. NROOT)  GO  TO  270 
BUPC  (L)  =BUP  (I  -1) 

290  LM=L 

295  IF  (BUP  ( I - 1 ) . LE . BLO ( I ) ) GO  TO  300 
IF  (RTOLV(I)  .GT.RTOL)  GO  TO  300 
BUPC  (L)  -BUP  (I) 

NEIV(L)  =NE  I V (L)  +1 
NROOT-NROOT+1 

IF  (NROOT. EQ.NV)  GO  TO  300 
1 = 1 + 1 

GO  TO  295 
C 

C F IND  SHI  FT 
300  WRITE  (6,1020) 

WRITE  (6,1005)  (BUPC (I ) , 1=1, LM) 

WRITE  (6,1030) 

WRITE  (6,1006)  (NE I V ( I ) ,1  = 1, LM) 

LL=LM- 1 

IF  (LM. EQ. 1)  GO  TO  310 
330  DO  320  1=1, LL 
320  NE  I V (L)  -NE  I V (L)  +NE  I V ( I ) 

L— L — 1 
LL-LL-1 

IF  (L.NE.l)  GO  TO  330 
310  WRITE  (6,1040) 

WRITE  (6,1006)  (NEIV(I)  , 1 = 1 ,LM) 

L=0 

DO  340  1-1 , LM 
L = L+  1 

IF  (NEIV(I) .GE. NROOT)  GO  TO  350 
340  CONTINUE 
350  SH I FT=BUPC  (L) 
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NE  I =NE  I V (L) 

C 

C SHIFT  MATRIX 

REWIND  NSTIF 
REWIND  NMASS 
REWIND  NRED 
DO  400  L=1 , NBLOCK 
READ  (NSTIF)  A 
READ  (NMASS)  XM 
DO  420  I =1 , NEQB 
420  A ( I ) =A  ( I ) -SHIFT*XM(I) 

WRITE  (NRED)  A 
400  CONTINUE 
I =NST I F 
NST I F-NRED 
NRED- I 
RETURN 
C 

1005  FORMAT  (1H0.6E22.14) 

1006  FORMAT  (1  HO , 6 I 22) 

1010  FORMAT  (37HO***ERROR  SOLUTION  STOP  IN  *SCHECK*,  / 12X, 

1 21HN0  EIGENVALUES  FOUND.,  / IX) 

1020  FORMAT  (37HOUPPER  BOUNDS  ON  EIGENVALUE  CLUSTERS  ) 

1030  FORMAT  (34HONO  OF  EIGENVALUES  IN  EACH  CLUSTER  ) 

1040  FORMAT  (42HONO  OF  EIGENVALUES  LESS  THAN  UPPER  BOUNDS  ) 

END 

FUNCTION  SO(TT) 

C 

C CALLED  BY?  SPECTR 
C 

COMMON  / JUNK  / MM, L.K.NTAG.NDYN, I ,T  (90) ,S (90) ,HED  (12) ,W,SS,S I , 
1 TI.IFILL1  (32) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL2  (14) 

IF  (NTAG.EQ.l)  GO  TO  500 
NTAG-1 
C 

C READ  SPECTRUM  (MAX  DISPL  AS  FUNCTION  OF  PERIOD) 

C 

READ  (5,1000)  HED 

WRITE  (6,2000)  HED 

READ  (5,1010)  NPTS.SFTR 

IF  (ABS(SFTR)  .LT.  l.OD-12)  SFTR-1 .ODO 

WRITE  (6,2010)  NPTS.SFTR 

READ  (5,1020)  (T(l)  , S (I ) , l-l.NPTS) 

WRITE  (6,2020)  (I  ,T(I)  ,S  (I ),  l-l.NPTS) 

IF  (MODEX.EQ.l)  RETURN 
500  CONTINUE 
C 

K-0 

DO  600  1-1 ,NPTS 
K-K+l 

IF  (TT.LT.T (I) ) GO  TO  700 
600  CONTINUE 
700  TK-T  (K)  -T  (K-  1) 

SK-S  (K) -S  (K-l) 


o o o o 
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ss-s(k-i)  + sk*(tt-t(k-D)/tk 

SD=SFTR*SS 


C 

1000  FORMAT  (1 2A6) 

1010  FORMAT  (I5.F10.0) 
1020  FORMAT  (2F10.0) 


c 

2000  FORMAT  (// 1 7H  SPECTRUM  TABLE  (.12A6.1H),/  IX) 

2010  FORMAT  (5X , 1 8HNUMBER  OF  POINTS  =,  14/ 

1 5X , 1 8HSCALE  FACTOR  = E14.5  / IX  ) 

2020  FORMAT  (6H  INPUT, 20X, 8HSPECTRUM,  / 6H  PO I NT, 8X , 6HPER I OD , 9X , 

1 5HVALUE,  / (I6.2E14.4)  ) 

C 

RETURN 

SUBROUT INE  SDSPLY  (TEMP,X, MMX , MAX , NCL ,NUM, NN, KKK, ISD, ISP,NPT, KT) 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


CALLS?  SPLOT , ELOUTS 
CALLED  BY?  STEP 

SUBROUTINE  TO  PRINT  RESPONSE  TABLES,  TO  PRODUCE  PRINTER  PLOTS 
OF  DISPLACEMENT  OR  STRESS  COMPONENTS,  OR  TO  RECOVER  MAXIMA  ONLY 

ISD  = 1,  STRESSES  KKK  = 1,  PRINT  RESPONSE  TABLES  + MAXIMA 

ISD  = 2,  DISPLACEMENTS  KKK  * 2,  PRINTER  PLOTS  + MAXIMA 

KKK  = 3,  RECOVER  MAXIMA 


COMMON  /ELPAR/  NPAR  (14) , I F I LL1  (10) 

COMMON  /EM/  SSA  (8,63)  ,KLM(8, 63) 

COMMON  /JUNK/  NDUM(6)  , NBL , LAST , KD  (2 ,8)  ,TM(8)  ,DM(8)  , D (8)  , I F LL  (358) 
COMMON  /DYN/  NT , NOT , DAMP , DT , BETA, I F I LL4 (4) 

D IMENS I ON  TEMP  (MAX.NCL)  ,X  (MMX,NCL) ,NUM(NN) 


C 

SET  TAPE  ASSIGNMENTS 


1.  FILE  FOR  COMPACTING  *TEMP*  RECORDS  INTO  *X*  RECORDS 


2 FILE  *KT*  IS  *TAPE4*  IF  DISPLACEMENTS  ARE  TO  BE  OUTPUT 
FILE  *KT*  IS  *TAPE7*  IF  STRESSES  ARE  TO  BE  OUTPUT 

REWIND  KT 

3.  *TAPE9*  CONTAINS  OUTPUT  REQUESTS  AND  ELEMENT  CONTROL  DATA 
NT9  * 9 

4.  *TAPE8*  CONTAINS  ELEMENT  STRESS/DISPLACEMENT  TRANSFORMATION 
MATRICES  PACKED  AS  8 COMPONENTS  PER  RECORD 


C 


NT8  = 8 
REWIND  NT8 
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C 5.  SCRATCH  FILES  FOR  PRODUCTION  OF  PRINTER  PLOTS 

C 

NT2  = 1 
NT4  = 2 
C 

C IF  *X*  IS  LARGER  THAN  *TEMP*,  PACK  *TEMP*  RECORDS  INTO  *X*  -- 
C OTHERWISE  PASS 

C 

I F (MAX. NE .MMX)  GO  TO  25 
I T=KT 

NBLOCK  - NBL 
GO  TO  80 
C 

C STORE  *NBL*  RECORDS  OF  *TEMP*  IN  THE  LARGER  ARRAY  *X*  (I.E., 

C MMX. GT. MAX) 

C 

25  K=0 

REWIND  IT 
NBLOCK  = 0 
DO  75  NB»1 , NBL 
READ  (KT)  TEMP 
DO  50  1=1 , MAX 
I I = I +K 

DO  50  J*1 , NCL 
50  X (I  I , J)-TEMP  (I  , J) 

K=K+MAX 
L = K+MAX 

IF  (L . LE .MMX)  GO  TO  75 

WRITE  (IT)  X 

K=0 

NBLOCK-NBLOCK+1 
75  CONTINUE 
C 

I F (K.EQ.O)  GO  TO  80 
WRITE  (IT)  X 
NBLOCK  = NBLOCK  +1 
C 

80  I F=0 

C /NN=1  , FOR  DISPLACEMENT  OUTPUT/ 

C /NN-NELTYP,  FOR  STRESS  OUTPUT/ 

DO  900  N= 1 ,NN 
C 

REWIND  NT2 
REWIND  NT4 

C SET  THE  NUMBER  OF  OUTPUT  RECORDS  TO  BE  PROCESSED  FROM  *TAPE9* 

MM=NUM(N) 

C READ  ELEMENT  CONTROL  PARAMETERS  FOR  STRESS  OUTPUT 

IF  (I SD.EQ.2)  GO  TO  90 
READ  (NT9)  NPAR 
MTYPE=NPAR  ( 1 ) 

90  I F (MM.EQ.O)  GO  TO  900 
C 

C LOOP  ON  THE  TOTAL  NUMBER  OF  OUTPUT  RECORDS  ON  *TAPE9* 

C 

DO  600  M= 1 , MM 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


C 

REWIND  IT 

IF(ISD.EQ.l)  READ  (NT8)  ND,  ( (SSA  (I  , J)  , 1 = 1 ,8)  , J*1  ,ND)  , 
1 ( (KLM  (I  , J)  , 1 = 1,8)  , J=1 , ND) 

READ  (NT9)  KD.L 
C 

GO  TO  (100,300,200) , KKK 
C 

C LABEL  HEADINGS  FOR  PRINTED  TIME  HISTORY  OUTPUT 
C 

100  IF  (ISD.EQ.l)  GO  TO  130 
WRITE  (6,1000)  M 

WRITE  (6,2001)  (KD  (1  , I)  ,KD  (2,  I)  , 1 = 1 ,L) 

GO  TO  300 

130  CALL  ELOUTS  (KD , L , MTYPE , M, ND) 

GO  TO  300 
C 

C LABEL  HEADINGS  FOR  PRINTING  OF  MAXIMA 
C 

200  IF  (M.GT . 1)  GO  TO  300 
IF  (ISD.EQ.l)  GO  TO  230 
WRITE  (6,1002) 

WRITE  (6,5001) 

GO  TO  300 

230  WRITE  (6,2002)  MTYPE 
WRITE  (6,1*001) 

C 

C COMPUTE  HISTORY 

C 

300  DO  320  1=1 ,L 
TM  ( I ) =0 . 

320  DM  ( I ) =0 . 

T I ME=0 . 

C 

C READ  DISPLACEMENT  HISTORY  IN  BLOCKS 

C 

NR  = MMX 
C 

DO  505  NB=1 , NBLOCK 
C 

READ  (IT)  X 

C PROCESS  *NR*  OUTPUT  STEPS  IN  THIS  BLOCK 

IF  (NB.LT. NBLOCK)  GO  TO  325 
NR  = NPT  - (NBLOCK- 1) *MMX 
325  CONTINUE 

DO  500  K-l ,NR 
TIME-TIME  + DT 
DO  1*50  1=1, L- 
GO  TO  (330,360) , ISD 
C COMPUTE  STRESSES 

330  DD=0 . 

DO  350  J=1 , ND 
J J=KLM ( I , J) 

IF(JJ)  350,350,3^0 
31*0  DD=DD+SSA  (I  , J)  *X  (K , J J) 
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350  CONTINUE 
GO  TO  400 

C SELECT  THE  DISPLACEMENT  COMPONENT 

360  JJ  = IF+I 
OD  = X (K, JJ) 

C UPDATE  THE  MAXIMUM  VALUE  OF  THE  COMPONENT 

400  AD-ABS(DD) 

I F (AD-DM ( I ) ) 450,450,445 
445  DM  ( I ) =AD 
TM  ( I ) =T I ME 
450  D (I) =DD 
C 

GO  TO  (480,490,500) , KKK 
C 

C PRINT  HISTORY  OUTPUT 
C 

480  WRITE  (6,1004)  T I ME , (D  ( I ) , I = 1 , L) 

GO  TO  500 
C 

C SAVE  DISPLACEMENTS  FOR  THE  PRODUCTION  OF  PLOTS 
C 

490  WRITE  (NT4)  D 
C 

500  CONTINUE 
C 

505  CONTINUE 
C 

C COMPLETE  THIS  OUTPUT  SET 
C 

GO  TO  (510,520,530) , KKK 

C MAXIMA  AT  THE  END  OF  A PRINTED  HISTORY 

510  WRITE  (6, 1005)  (DM  ( I ) , 1=1 ,L) 

WRITE  (6,1006)  (TM  ( I ) , I = 1 , L) 

GO  TO  600 

C SAVE  OUTPUT  SET  DATA  FOR  PRINTER  PLOTS 

520  WRITE  (NT2)  KD , DM.TM, L 
GO  TO  600 

C PRINT  SUMMARY  OF  MAXIMA  ONLY 

530  WRITE  (6,1007)  (KD  (1  , I ) ,KD(2,  I)  ,DM(I)  ,TM(I)  , I = 1 , L) 
C 

600  IF-IF+L 
C 

C PLOT  SET  OF  VALUES 
C 

IF  (KKK .NE . 2)  GO  TO  900 
REWIND  NT2 
REWIND  NT4 
C 

DO  800  M=  1 , MM 
GO  TO  (610,620) , ISD 
C 

610  WRITE  (6,4000)  MTYPE.M 
WRITE  (6,4001) 

GO  TO  630 
C 
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C 

c 

c 

c 


620  WRITE  (6,5000)  M 
WRITE  (6,5001) 

630  CALL  SPLOT  (NT2.NT4.NPT, ISP) 
800  CONTINUE 
900  CONTINUE 
RETURN 


C 

C 

C 


FORMATS 


ACEMENT  TIME 
//  14X,27H*N0DE  NUMBER* 


H I STORY,  // 
(COMPONENT  , 


■ 3) 


1000  FORMAT  (50H1D  I S P L 

1 1 3H  OUTPUT  SET  =, I 4, 

2 7HNUMBER) , IX)  . 

1002  FORMAT  (38HID  ISPLACEMENT  MAXIMA,  //IX) 

1004  FORMAT  (F  1 2 . 5 . 2X , 1 P8E 1 2 . 3)  „ ,Y  lpon, 

1005  FORMAT  (/  24H  MAXIMUM  ABSOLUTE  VALUES,  //  8H  MAX  I MUM, 6X , 1 P8E 1 2 

1006  FORMAT  (5H  TIME.9X, 1 P8E 1 2 . 3) 

1007  FORMAT  (18, 12X. I 3, 1 P 2 E 1 4 . 4 , 7 X , 2HN A) 

2001  FORMAT  (8X , 4HT I ME , 2X , 8 (3X. I 4, 2H- (, I 2, 1H) ) /IX) 

2002  FORMAT  (46H1S  TRESS  COMPONENT  MAXIMA,// 

1 22H  ELEMENT  TYPE  NUMBER  =,  13.  //  IX) 

4000  FORMAT  (51H1N0RMAL  I ZED  STRESS  HI  STORY, 3X, 

1 7HP  L 0 T,  //  22H  ELEMENT  TYPE  NUMBER  =,  13  / 

2 22H  OUTPUT  SET  NUMBER  =,  1 3 //  IX) 

4001  FORMAT  (8H  ELEMENT , 9X , 6HSTRESS , 7X , 7HMAX I MUM, 7X, 7HT I ME  AT,5X, 

1 4HPL0T , / 8H  NUMBER, 6X,9HC0MP0NENT,9X,5HVALUE,7X,7HMAXIMUM,3X, 

2 6HSYMB0L,  /IX)  u_..  T-Y 

5000  FORMAT  (46H1N  ORMALIZED  DISPLACE  MEN  ',3X, 

1 23HH  ISTORY  PLOT,//  22H  OUTPUT  SET  NUMBER  -,  1 3// IX) 

5001  F ORHAT  (4X. FtHNODE , }X, 1 2HD I SPLACEMENT.7X,  7HKAX I MUM.7X*  7HTI  HE  AT, 

2 5X.4HPL0T,  / 8H  NUMBER. 6X,9HCOMPONENT.9X,5HVALUE.7X,7HMAXIMUM, 

3 3x’,6HSYMB0L,  / IX) 

c 

ESUBROUTINE  SECNTD  (A,B,V,MAXA,W,W,WW,R00T,TIM,ERRVL,ERRVR, 

1 N I TE , N , MA , NROOT , NC, I FPR, ANORM, COFQ) 

REAL  T I Ml ,T I M2 ,T I M3 


C 

C 

C 

c 


c 

c 


CALLS?  BANDET 
CALLED  BY?  MODES 

COMMON  /TAPES/NSTI F ,NRED,NL,NR,NT,NMASS 

DIMENSION  A (N , NC)  , B (N)  ,V  (1)  ,W  (1)  ,VV  (N,  1)  ,WW  (N,  1)  .ROOT  (1)  , 
1TIM(1)  , ERRVL  (1)  , ERRVR  (1) 

INTEGER  NITE  (1)  ,MAXA (1) 

COMMON  /EM/  AT  (1000) , IF  ILL (3138) 

THE  FOLLOWING  TOLERANCES  ARE  SET  FOR  THE  IBM  370 
ACT0L=1 .0D-04 
RCBT0L=1 .0-05 
RT0L=1 .00-10 
RQT0L=1 .OD-12 
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C SCALE-2. 000**200 
C 

NTF-5 
I ITEM-10 
N ITEM-60 
NVM-6 
C 

REWIND  NT 
REWIND  NMASS 
READ  (NMASS)  B 
C 

C ETA-2.0 

NOV-O 
JR- 1 
NSK-0 
NWA=N*MA 
I SC- 1 000 

c 

C FIND  LOCATIONS  FOR  NEGATIVE  ELEMENTS  IN  STARTING  ITERATION  VECTORS 
C 

REWIND  NSTIF 

READ  (NSTIF)  (A  ( I , 1 ) , I =1 , N) 

DO  1 1-1, N 
AA-A  (I  , 1) 

IF  (AA.GT.O.)  GO  TO  1 
WRITE  (6,1000)  I , AA 
STOP 

1 V ( I ) =B  ( I ) /AA 
DO  2 J-3.NC 
RMAX-O . 

DO  3 1=1, N 

IF  (V(l)  . LT.RMAX)  GO  TO  3 
RMAX-V(I) 

I MAX- 1 

3 CONTINUE 

NITE (J) - 1 MAX 

2 V ( I MAX) -0 . 

C 

C CHECK  FOR  SINGLE  DEGRE E-OF-FREEDOM  SYSTEM 
C 

IF  (N.GT.l)  GO  TO  5 
I F (B  (1)  .GT.O.)  GO  TO  7 
WRITE  (6, 1 180) 

STOP 

7 REWIND  NSTIF 

READ  (NSTIF)  A (1,1) 

ROOT  (1)-A(1,1)/B(1) 

NSCH-1 

A (1  , 1)-1  .ODO/SQRT  (B  (1)) 

GO  TO  950 
C 

C***  5 CALL  TT I ME  (T I Ml)  !5  IS  TRANSFERED  TO  THE  NEXT  LINE 

5 RA-O.O 

RR-O.O 
KA-0 
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KB=0 

KR=0  1#.„ 

CALL  BANDET  (A , B , V.MAXA , N , NWA , RA , NSCH , DETA, I SC, 1) 

FA=DETA 
FR=F  A 
DETR=DETA 
C 

c CHECK  FOR  ZERO  E I GENVALUE  (S) 

IF  (A  (N , 1)  .GT.  ANORM)  GO  TO  10 
WRITE  (6,1009) 

STOP 

C 

C FIND  LOWER  BOUND  ON  SMALLEST  EIGENVALUE 
10  IF  (IFPR.EQ.l) 

* WRITE  (6, 1010) 

DO  100  1=1, N 
100  W ( I ) =B  ( I ) 

RT=0 .0 
I I TE=0 
KK=2 

110  I I TE= I I TE+1 
DO  120  1=1, N 

CALL  BANDET  (A , B , V , MAXA , N , NWA , RA , NSCH , DETA, I SC , KK) 
KK=2 
RQT=0 .0 
DO  130  1=1, N 
1 30  RQT=RQT+W ( I ) *V ( I ) 

DO  180  I = 1 , N 
180  W(I)=B(I)*V(I) 

RQB=0.0 
DO  140  1=1, N 
140  RQB=RQB+W  ( I ) *V  ( I ) 

RQ-RQT/RQB 
IF  (IFPR.EQ.l) 

* WRITE  (6,1004)  RQ 
BS=SQRT  (RQB) 

TOL=ABS  (RQ-RT) /RQ 
IF  (TOL.LT.RCBTOL)  GO  TO  150 
DO  160  1=1, N 
W(I)=W(I)/BS 
RT=RQ 

IF  (I ITE.LT. I ITEM)  GO  TO  110 

DO  170  1=1, N 
V (I)  =V  (I)  /BS 

RB=RQ*  (1 .ODO-DMI N1  (1 .OD- 1 , 1 .0D2*T0L) ) 

CALL  BANDET  (A , B, V, MAXA , N , NWA , RB , NSCH , DETB, I SC, 1) 
IF  (IFPR.EQ.l) 

* WRITE  (6,1020)  RB.NSCH 
FB=DETB 

IF  (NSCH.EQ.O)  GO  TO  300 
IF  (NSCH.EQ.O)  GO  TO  299 
I S= I S+l 


160 


c 

150 

170 


230 


c 
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IF  (IS.LE.NTF)  GO  TO  240 
WRITE  (6,1030)  NTF 
STOP 

240  RB-RB/ (NSCH+1 ) 

GO  TO  230 
C 

C ITERN  FOR  INDIVIDUAL  ROOTS 
299  ETA-2. DO 
300  IF  (IFPR.EQ.l) 

* WRITE  (6,1040) 

NITE  (JR)  — 1 

IF  (IFPR.EQ.l) 

* WRITE  (6,1050)  JR, NITE  (JR) , RA , DETA, FA, ETA, ISC 
NITE  (JR)  =0 

IF  (IFPR.EQ.l) 

* WRITE  (6,1050)  JR, NITE  (JR)  ,RB, DETB , FB, ETA , ISC 
C 

C WE  STOP  WHEN  WE  HAVE  THE  REQUIRED  NO  OF  ROOTS  SMALLER  THAN  RC  AND 
C N0V=O 

310  IF  (NSCH.GE .NROOT)  GO  TO  900 

I F (RB.GT.COFQ)  GO  TO  900 

C 

IF  (KB-KA)  301,303,302 
C***  301  FB=FB*1.D50 

301  FB=FB*1 .038 
KB-KB+1 

GO  TO  303 

C*ft*  302  F A=F A* 1 .D50 

302  FA=FA*1 . D 38 
KA-KA+1 

C DIF-FB-FA 

303  DIF-FB-FA 

IF  (DIF. NE. 0.0)  GO  TO  320 

WRITE  (6,1060) 

GO  TO  900 

320  DEL-FB*  (RB-RA) /D I F 
RC=RB-ETA*DEL 
T0L=RCBT0L*RC 

IF  (ABS(RC-RB)  .GT.  TOL)  GO  TO  330 
IF  (IFPR.EQ.l) 

* WRITE  (6,1070) 

ROOT  (JR) -RB 
GO  TO  400 

C 

330  CALL  BANDET  (A,B, V,MAXA,N,NWA,RC,NSCH,DETC, I SC, 1) 

FC-DETC 

KC-0 

NITE  (JR) -NITE  (JR)  H- 1 
I F (JR.EQ. 1)  GO  TO  340 
JJ-JR-1 
DO  350  K-l , JJ 

C***  IF  (ABS  (FC) .GT. 1 .D-50)  GO  TO  350 

IF  (ABS  (FC) .GT. 1 .D-38)  GO  TO  350 
FC=FC*1 .050 
FC=FC*1 .D38 


C**>v 
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KC=KC+1 

350  FC=FC/ (RC-ROOT  (K) ) 

31*0  IF  (IFPR.EQ.l) 

* WRITE  (6,1050)  JR.NITE  (JR)  .RC.DETC.FC.ETA, ISC 

C IF  WE  HAVE  MORE  S I GNCHANGES  THAN  EIGENVALUES  SMALLER  THAN  RC  WE 
C START  INV.  ITERATION 
NES=0 

IF  (JR.EQ.l)  GO  TO  380 
DO  360  1=1 , JJ 

36O  IF  (ROOT  (I)  .LT .RC)  NES=NES+1 

38O  NOV=NSCH-NES 

IF  (NOV.EQ.O)  GO  TO  370 
IF  (IFPR.EQ.l) 

* WRITE  (6,1080)  NOV 
ROOT  (JR)  =RC 

IF  (NOV.GT.l)  NSK=1 
C 

GO  TO  400 
370  RR=RA 
FR=F  A 
DETR=DETA 
RA=RB 
F A=F  B 
DETA=DETB 
RB=RC 
FB=F  C 
DETB=DETC 
KR=KA 
KA=KB 
KB=KC 
C 

c WE  RESET  ETA  IF  NECESSARY 
TOL=RB*ACTOL 

IF  (ABS(RA-RB)  .LT.  TOL)  ETA=ETA*2 .ODO 
IF  (NITE  (JR)  .LE.NITEM)  GO  TO  310 
WRITE  (6,1015)  JR.NITE  (JR) 

GO  TO  900 
C 

C CHECK  FOR  STORAGE 
1*00  IF  (JR.LE.NC)  GO  TO  405 
WRITE  (6,10*90) 

GO  TO  900 
C 

405  NOR-JR-1 

IF  (NOR.GT.NVM)  NOR-NVM 
C***  CALL  TTIME(TIM3) 

IF  (IFPR.EQ.l) 

* WRITE  (6, 1100)  NOR 
IF  (JR.EQ.l)  GO  TO  410 
DO  420  1=1 ,N 
420  V ( I ) =1 .0 
KK— 2 

IF  (JR.EQ.NC)  GO  TO  410 
I - N ITE  (JR+1) 
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V (I)  - -]. 

410  DO  430  I = 1 , N 
430  W ( I ) =B  (!)  *V  ( I ) 

IS=0 

GO  TO  510 
C 

C INVERSE  ITERN 
440  NITE  (JR)  =NITE  (JR)+1 
DO  450  l-l,N 
450  V ( I ) =W  ( I ) 

CALL  BANDET  (A , B , V.MAXA , N , NWA , RC , NSCH, DETC, I SC, KK) 
IF  (IS.EQ.l)  GO  TO  460 
KK=2 
RQT=0 .0 
DO  470  1=1, N 
470  RQT-RQT+W  ( I ) *V ( I ) 

DO  475  1=1, N 
475  W(I)=B(I)*V(I) 

RQB=0 .0 
DO  480  1=1 ,N 
480  RQB=RQB+W(I)  *V(I) 

RQ=RQT/RQB 
RT=ROOT (JR) +RQ 
IF  (IFPR.EQ.l) 

* WRITE  (6,1110)  JR.NITE (JR)  ,RT,RQ 
TOL=RT*RQTOL 

IF  (ABS  (RT-RTA)  .GT.  TOL)  GO  TO  510 
I S=  1 

GO  TO  440 
C 

510  RTA-RT 

BS=SQRT  (RQB) 

DO  490  I = 1 , N 
490  W(I)=W(I)/BS 

I F (NOR.EQ.O)  GO  TO  550 
DO  520  K= 1 , NOR 
AL-0.0 

DO  530  1=1, N 
530  AL=AL+VV (I , K) *W  ( I ) 

DO  540  1=1, N 

540  W(I)«W(I)-AL*WW(I  ,K) 

520  CONTINUE 
C 

550  IF  (NITE (JR) .LE.NITEM)  GO  TO  440 
WRITE  (6,1015)  JR.NITE  (JR) 

GO  TO  900 
C 

460  RQT=0 .0 

ERRT-RQB 
DO  570  1=1, N 
570  RQT=RQT+V ( I ) *W ( I ) 

DO  560  1=1 ,N 
560  W(I)«B(I)*V(I) 

RQB=0 .0 
DO  580  1=1, N 
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580  RQB=RQB+V  (I)  *W(I) 

C 

C OBTAIN  A RATHER  LARGE  ERROR  BOUND 
RQ=RQT/RQB 

ROOT  (JR)  =ROOT  (JR)+RQ 
ERR=SQRT  (ERRT/RQB) 

ERRVL  (JR)  =ROOT  (JR)  -ERR 
ERRVR  (JR) =ROOT (JR) +ERR 
C 

BS=SQRT  (RQB) 

DO  590  1=1, N 
W(I)=W(I)/BS 
590  V(I)-V(I)/BS 
J J=JR 

IF  (JJ.LE.NVM)  GO  TO  610 
WRITE  (NT)  (VV(J.l)  ,J=1,N) 

DO  600  K=1,N 
DO  600  L=2 , NVM 
WW(K,L-1)=WW(K,L) 

600  VV (K , L- 1 ) =VV  (K , L) 

J J=NVM 

610  DO  620  K-l.N 
WW  (K , J J)  =W  (K) 

620  VV  (K , J J)  =V  (K) 

C 

c***  CALL  TT I ME (T I M2) 

TIM3=TIM2-TIM3 
IF  (IFPR.EQ.l) 

* WRITE  (6,1120)  T I M3 
T I M (JR)  -TIM2-TIM1 
T I Ml =T I M2 
C 

C DECIDE  STRATEGY  FOR  ITERN  TOWARDS  NEXT  ROOT 
TOL=RTOL*ROOT  (JR) 

IF  (NOV.GT.O)  GO  TO  700 
IF  (ABS  (ROOT  (JR)  -RB)  .GT.  TOL)  GO  TO  710 
I F (RA.GT.O.O)  GO  TO  720 
RA=RB/2 . 

CALL  BANDET  (A , B , V.MAXA , N , NWA , RA , NSCH , DETA, I SC, 1) 
FA=DETA 
KA=0 

720  RB=RA 
FB-FA 
KB=KA 
KA=KR 
DETB-DETA 
RA=RR 
F A=FR 
DETA=DETR 
GO  TO  710 
C 

700  IF  (ROOT  (JR)  .GT.RC)  NSK=1 
IF  (NSK.EQ.l)  GO  TO  730 
IF  (ABS  (RC-ROOT  (JR) ) .LT.  TOL)  GO  TO  7^0 
IF  (ABS  (ROOT  (JR) -RB)  .LT.  TOL)  GO  TO  750 
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RA=RB 
F A=FB 
DETA=DETB 
KA=KB 

750  RB-RC 
FB=FC 
KB=KC 
DETB=DETC 
GO  TO  710 

7^0  IF  (ABS  (ROOT  (JR) -RB)  .GT.  TOL)  GO  TO  710 
IF  (RA.GT.O.O)  GO  TO  760 
RA=RB/2 . 

CALL  BANDET  (A , B , V, MAXA , N , NWA , RA , NSCH , DETA , I SC , 1) 
FA=DETA 
KA=0 

760  RB=RA 
FB=F  A 
KB=KA 
KA=KR 
DETB-DETA 
RA=RR 
FA=FR 
DETA-DETR 

710  FA=FA/ (RA-ROOT (JR) ) 

FB*FB/  (RB-ROOT (JR) ) 

JR=JR+1 

C***  IF  (ABS  (FA)  .GT. 1 .D-50)  GO  TO  711 

IF  (ABS  (FA)  .GT. 1 .D-38)  GO  TO  711 

C***  FA=FA*1.D50 

FA=FA*1 .D38 
KA=KA+1 

C***  711  IF  (ABS  (FB)  .GT. 1 .0-50)  GO  TO  299 

711  IF  (ABS  (FB)  .GT. 1 .D-38)  GO  TO  299 
C***  FB=FB*1 . D50 

FB-FB*1 .D38 
KB=KB+1 

C ETA=2 .0 

C GO  TO  300 

GO  TO  299 
C 

730  IF  (RA.GT.O.O)  GO  TO  780 
RA=RB/2 . 

CALL  BANDET  (A , B , V.MAXA ,N , NWA , RA ,NSCH, DETA. I SC, 1) 
FA-DETA 
KA-0 

780  IF  (ABS  (ROOT  (JR) -RB)  .GT. TOL)  GOTO  770 
RB-RA 
FB-FA 
KB-KA 
KA-KR 
DETB-DETA 
RA-RR 
F A=FR 
DETA-DETR 

770  FA=FA/ (RA-ROOT (JR)) 
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FB-FB/ (RB-ROOT (JR) ) 

fr=fr/(rr-root(jr)) 

C***  IF  (ABS(FA) .GT.l .D-50)  GO  TO  771 

IF  (ABS  (FA)  .GT.l .D-38)  GO  TO  771 
F A=F  A* 1 . D50 
FA=FA*1 .D38 
KA=KA+! 

C***  771  I F (ABS  (FB)  .GT. 1 .D-50)  GOTO  772 

771  I F (ABS  (FB)  .GT.  1 .D-38)  GO  TO  772 

C***  FB=FB*1.D50 

FB-FB* 1 .038 
KB-KB+1 

C***  772  IF  (ABS  (FR)  .GT.l. D-50)  GO  TO  773 

772  I F (ABS  (FR)  .GT. 1 .D-38)  GO  TO  773 

C***  FR=FR*1 .D50 

FR-FR* 1 .D38 
KR-KR+1 

C IF  (ROOT  (JR)  . LE .RC)  NOV=NOV-l 

773  IF  (ROOT  (JR)  . LE .RC)  NOV-NOV-1 

JR-JR+1 
NITE  (JR) =0 
ROOT  (JR)  -RC 

I F (NOV.GT.O)  GO  TO  1*00 
NSK-0 

C ETA=2 .0 

C GO  TO  300 

GO  TO  299 
C 

900  NROOT-JR- 1 

IF  (NROOT.GT.O)  GO  TO  902 
WRITE  (6,1180) 

STOP 

902  CONTINUE 

IF  (IFPR.EQ.O)  GO  TO  905 
WRITE  (6,1140) 

WRITE  (6,1006)  (NITE  (J) ,J-1 .NROOT) 
WRITE  (6,1150) 

WRITE  (6,1008)  (TIM  (J) ,J-1 .NROOT) 
WRITE  (6,1160) 

WRITE  (6,1004)  (ERRVL(J)  ,J=1, NROOT) 
WRITE  (6,1004)  (ERRVR(J) ,J=1, NROOT) 
C 

C READ  EIGENVECTORS' INTO  CORE 

905  IF  (NROOT. LE.NVM)  GO  TO  906 
NDIF-NROOT  - NVM 

REWIND  NT 

DO  904  L-l , ND I F 

READ  (NT)  (A  ( 1 , L)  .1-1, N) 

904  CONTINUE 
GO  TO  908 

906  NDIF-0 

908  NROOT=NROOT  - ND I F 
DO  912  L-l , NROOT 
DO  912  l-l , N 

912  A ( I , L+ND I F) -VV  ( I , L) 
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C ARRANGE  EIGENVALUES  AND  VECTORS  IN  ASCENDING  ORDER 
I F (JR.EQ.2)  GO  TO  950 
JR=JR-2 
910  I S=0 

DO  920  1=1 , JR 

IF  (ROOT  (1  + 1)  .GE .ROOT  (I) ) GO  TO  920 

IS-IS+1 

RT=ROOT (1+1) 

ROOT  (I  + 1 ) =ROOT  ( I ) 

ROOT(l)=RT 
DO  930  K= 1 , N 
RT=A  (K, 1 + 1) 

A (K,  l+l)-A  (K,  I) 

930  A (K , I ) =RT 
920  CONTINUE 

IF  (IS.GT.O)  GO  TO  910 
C 

950  WRITE  (6,1170) 

NROOT=NSCH 

WRITE  (6,1004)  (ROOT  (J) , J=1 ,NROOT) 

C 

C CALCULATE  PHYSCIAL  ERROR  NORMS 
C 

REWIND  NT 
DO  955  L= 1 , NROOT 
955  WRITE  (NT)  (A  (K,  L)  ,K=1  ,N) 

REWIND  NSTIF 

READ  (NSTIF)  (A  (I  , 1)  ,I  = 1,NWA) 

REWIND  NT 
DO  960  L=1 .NROOT 
RT  = ROOT  (L) 

READ  (NT)  (V  ( I ) , I = 1 , N) 

CALL  MULT  (W.A.V.N.MA) 

VN0RM=O . 

DO  958  1=1, N 

958  VNORM  = VNORM  + W(I)*W(I) 

DO  966  1=1 ,N 

966  W (I ) = W(l)  -RT*B  (l)*V(l) 

WNORM  =0.0 
DO  968  I = 1 , N 

968  WNORM  = WNORM  + W(I)*W(I) 

VNORM  -SQRT  (VNORM) 

WNORM  -SQRT  (WNORM) 

ERRVL  (L)  = WNORM/VNORM 
960  CONTINUE 
REWIND  NT 
DO  969  L=l, NROOT 

969  READ  (NT)  (A  (K , L)  , K=  1 , N) 

WRITE  (6,1190) 

WRITE  ( 6,1004)  (ERRVL  (J) ,J=1 .NROOT) 

REWIND  NT 
DO  970  1=1, NROOT 
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970 


980 


ROOT (I ) =SQRT  (ROOT  ( I ) ) 

WRITE  (NT)  (ROOT (I) , 1=1 .NROOT) 
NWA=N*NROOT 

WRITE  (NT)  (A  (I  ,0,1*1  , NWA) 

PI 2=8.0D0*ATAN (1 .000) 

DO  980  1=1 , NROOT 
AT  (I ) *P I 2/ROOT ( I ) 


RETURN 


1000  FORMAT 


1 


1001* 

1006 

1008 

1009 


FORMAT 

FORMAT 

FORMAT 

FORMAT 


(44H  ***ERROR 
Ell  .4,2 1 HBEFORE 
(1H0.6E20. 12) 

(1  HO, 6 1 20) 
(1H0.6F20.2) 
(43HO***ERROR 


NEG  OR  ZERO  DIAGONAL 
DECOMPOSITION 


SOLUTION  TERMINATED 


ELEMENT 

) 


A (, I 4,4H)  = 


/ 


1 


1010  FORMAT 
1 


IN  *SECNTD*, 

1 2X , 25HR I G I D BODY  MODE (S)  FOUND.,  / IX) 

(51H1 INVERSE  ITERATION  GIVES  FOLLOWING  APPROXIMATION  TO, 
18H  LOWEST  EIGENVALUE,  IX) 

1015  FORMAT  (41H0***ERR0R  PRE-MATURE  EXIT  FROM  *SECNTD*, 

1 37H I TERAT I ON  ABANDONED  FOR  ROOT  NUMBER  -,  14  / 

2 37HNUMBER  OF  ITERATIONS  PERFORMED  =.  I A / 

(5H0RB  = E20.12.7H  NSCH  = 1 4) 

(38H0***ERR0R  solution  stop  in  *SECANTD*.  / 1 2X , 1 H (, 

1 3.48H)  FACTORIZATIONS  PERFORMED  IN  AN  ATTEMPT  TO  FIND, 

32H  LOWER  BOUND  ON  FIRST  EIGENVALUE,  / 12X, 

16HCHECK  THE  MODEL.,  / IX) 

(1H1 , 4X , 4HR00T, 4X , 4HN I TE , l8X.2HRC.15X, 12HDET  (A-RC*B) , 15X, 


/ 12X, 

12X, 

IX) 


1020 

1030 


FORMAT 

FORMAT 


1040  FORMAT 


./2HFC,13X,3HETA,4X,3HISC) 


1050 

1060 

1070 

1080 

1090 


FORMAT 

FORMAT 

FORMAT 

FORMAT 

FORMAT 


1 

2 

3 

4 

5 

1100 

1110 

1120 

1140 

1150 

1160 

1170 

1180 


FORMAT 

FORMAT 

FORMAT 

FORMAT 

FORMAT 

FORMAT 

FORMAT 

FORMAT 


1 

1190  FORMAT 
1 


(1H0.4X, I4.4X, I4,8X,3E22.14,F7.2, 16) 

(42H0THE  DEFLATED  POLYNOMIAL  HAS  NO  MORE  ROOTS  ) 
(29H0  (RC-RB)  IS  SMALLER  THAN  TOL  ) 

(16H0WE  JUMPED  OVER  I4.16H  UNKNOWN  ROOT (S)  ) 

(41HO***ERROR  PRE-MATURE  EXIT  FROM  *SECNTD*. 

34H  CAUSED  BY  EITHER  OF  THE  FOLLOWING,  / 12X, 

22H  (1)  BAD  MODEL  DATA,  OR,  / 12X, 

52H  (2)  ROOT  CLUSTER  (I.E.,  NEAR  EQUAL  OR  REPEATED 
36HVALUES)  ENCOUNTERED  AT  CURRENT  SHIFT,  / l6X, 
25HCAUS I NG  STORAGE  OVER-FLOW,  IX) 

(1  HO , 34X , 4HR00T , l8X,2HRQ, l8X,4HN0R=, 12) 

(1  HO , 4X , I 4 , 4X , I 4 , 8X , 2E22 . 14) 

(20H0T I ME  FOR  I NV  ITERN  F5-2) 

(42H0N0  OF  ITERATIONS  FOR  EACH  EIGENVALUE  ARE  /) 
(30H0TIME  USED  FOR  EACH  EIGENVALUE  /) 
(43HOFOLLOWING  ARE  ERROR  BOUNDS  ON  EIGENVALUES  ) 
(///  40H  WE  SOLVED  FOR  THE  FOLLOWING  EIGENVALUES 

(37HO***ERROR  SOLUTION  STOP  IN  *SECNTD*,  / 12X, 
23HN0  EIGENVALUES  COMPUTED,  / IX) 

(///  40H  THE  FOLLOWING  ARE  PHYSICAL  ERROR  BOUNDS, 
20H  ON  THE  EIGENPAIRS  ) 


EIGEN, 


SUBROUTINE  SELECT  (MAT , NEL ,T ,TM, E , XNU, ALP, MAX, YM, PR, THERM) 
common  /say/  neqq , numee, 1 oopur , nnb 1 ock , nterms ,opt 1 on 
common  /what/  naxa  (10000) , i rowl  (10000) , i col h (10000) 
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C 

C 

C CALLED  BY?  PIPEK 

C 

C THIS  ROUTINE  SELECTS  MATERIAL  PROPERTIES  FROM  TABLES  USING 

C LINEAR  INTERPOLATION  WITH  TEMPERATURE 

C 

DIMENSION  TM  (MAX , 1) ,E  (MAX, 1)  , XNU  (MAX, 1) , ALP  (MAX, 1) 

C 

C IF  THE  TABLE  HAS  FEWER  THAN  MAX  ENTRIES,  THE  TEMPERATURE  VALUE 
C FOLLOWING  THE  LAST  REAL  ENTRY  IS  EQUAL  TO  -10000.0.  IF  THE  SECOND 

C TEMPERATURE  POINT  IS  -10000.0,  THE  TABLE  HAS  ONE  POINT,  AND  NO 

C INTERPOLATION  IS  PERFORMED. 

C 

I F (MAX.LT.2)  GO  TO  5 
IF  (TM(2,MAT)  .GT.-9999-)  GO  TO  10 
5 YM  = E (1 .MAT) 

PR  = XNU  ( 1 , MAT) 

THERM  = ALP  (1 .MAT) 

RETURN 

C 

10  DO  20  K=2 , MAX 

IF  (TM(K.MAT)  .LT.-9999.)  GO  TO  30 
N = K 

IF  (T.GE.TM(K-l.MAT)  .AND.  T.  LT.TM  (K.MAT) ) GOTO  40 
20  CONTINUE 
C 

30  WRITE  (6,3000)  T.NEL.MAT 

STOP 
C 

1*0  DT  = TM  (N  .MAT)  - TM  (N- 1 , MAT) 

I F (DT.GT. 1 .OE-8)  GO  TO  50 
K = N- 1 

WRITE  (6,3010)  K.N.MAT 
STOP 
C 

50  RATIO  = (T-TM  (N- 1 , MAT) ) / DT 

YM  = E (N- 1 .MAT)  + RATIO*  ( E (N,MAT)  - E(N-l.MAT)) 

PR  = XNU(N-I.MAT)  + RATIO*  (XNU  (N, MAT)-  XNU  (N- 1 .MAT) ) 

THERM  = ALP(N-l.MAT)  + RATIO*  (ALP  (N,MAT) - ALP (N- 1 .MAT) ) 

C 

RETURN 

C 

C 

3000  FORMAT  (36HOERROR***  THE  AVERAGE  TEMPERATURE  (,F12.3,5H)  FOR, 

1 10H  ELEMENT  (,I4,1H),  / 1 1 X , 28HCANN0T  BE  FOUND  IN  THE  TABLE, 

2 22H  FOR  MATERIAL  NUMBER  (,I4,2H).,  / IX) 

3010  FORMAT  (5 1HOERROR***  ZERO  OR  NEGATIVE  TEMPERATURE  DIFFERENCE  , 

1 16HBETWEEN  POINTS  (,I4,  7H)  AND  (,H»,1H),  / 11X,  9HMATER I AL  , 

2 7HTABLE  (, I4.2H) .,  / IX) 

C 

END 

SUBROUTINE  SESOL  (A, B , MAXA, NEQ.MA , NV.NBLOCK.NEQB.NAV, M I , NSTI F , 

1 NRED.NL.NR) 

C 
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C CALLED  BY?  SOLEQ 
C 

DIMENSION  A (NAV)  ,B  (NAV)  ,MAXA  (Ml) 
C 

MM=  1 

MA2-MA  - 2 
I F (MA2 . EQ.O)  MA2=1 
I NC=NEQB  - 1 
NWA=NEQB*MA 
NTB=  (MA-2) /NEQB  + 1 
NEB«NTB*NEQB 
NEBT*NEB  + NEQB 
NWV=NEQB*NV 
NWVV=NEBT*NV 
C 

Nl-NL 

N2=NR 

REWIND  NSTIF 
REWIND  NRED 
REWIND  N 1 
REWIND  N2 
C 

C MAIN  LOOP  OVER  ALL  BLOCKS 

DO  600  NJ-1 .NBLOCK 
IF  (NJ.NE.l)  GO  TO  10 
READ  (NSTIF)  A 
IF  (NEQ.GT. 1)  GO  TO  100 
MAXA  (1) =1 

WRITE  (NRED)  A, MAXA 
IF  (A  (1) ) 1,174,3 
1 KK=1 

WRITE  (6, 1010)  KK , A ( 1 ) 

3 DO  5 L-l.NV 
5 A (1+L)  =A  (1+L)  /A  (1) 

KR=1+NV 

WRITE  (NL)  (A  (KK)  , KK=2 , KR) 

RETURN 

10  IF  (NTB.EQ.l)  GO  TO  100 

REWIND  N 1 
REWIND  N2 
READ  (Nl)  A 
C 

C FIND  COLUMN  HEIGHTS 

100  KU=1 

KM-MINO  (MA.NEQB) 

MAXA  (1)  *1 
DO  110  N-2.MI 
IF  (N-MA)  120,120,130 
120  KU-KU  + NEQB 
KK=KU 

MM=M I NO (N , KM) 

GO  TO  140 
130  KU-KU  + 1 
KK-KU 

IF  (N-NEQB)  140,140,136 
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136 

MM=MM  - 1 

140 

DO  160  K=1 ,MM 

IF  (A  (KK) ) 110,160,110 

160 

KK=KK  - INC 

] 10 

MAXA  (N) =KK 

c 

IF  (A  (1) ) 172,174,176 

174 

KK=(NJ-1)*NEQB  + 1 
IF  (KK.GT.NEQ)  GO  TO  590 
WRITE  (6,1000)  KK 
STOP 

172 

KK= (NJ-1) *NEQB  + 1 
WRITE  (6,1010)  KK , A ( 1 ) 

C 

c 

FACTORIZE  LEADING  BLOCK 

176 

DO  200  N-2.NEQB 
NH=MAXA  (N) 

IF  (NH-N)  200,200,210 

210 

KL=N  + INC 

K=N 

D*0 . 

DO  220  KK=KL , NH , INC 

K=K  - 1 

C=A  (KK)  /A  (K) 

D=D  + C*A(KK) 

220 

A (KK) =C 
A (N)  =A  (N)  - D 

c 

IF  (A  (N) ) 222,224,230 

224 

KK=  (NJ- 1 ) *NEQB  + N 
IF  (KK.GT.NEQ)  GO  TO  590 
WRITE  (6,1000)  KK 
STOP 

222 

KK=  (NJ-1) *NEQB  + N 
WRITE  (6,1010)  KK , A (N) 

c 

230 

IC-NEQB 

DO  240  J-1.MA2 
MJ-MAXA(N+J)  - 1C 
IF  (MJ-N)  240,240,280 

280 

KU=M 1 NO  (MJ.NH) 

KN*N  + 1C 
C-0. 

DO  300  KK-KL.KU, INC 

300 

C-C  + A (KK) *A  (KK+I C) 
A (KN)  “A  (KN)  - C 

240 

ICHC  + NEQB 

c 

K-N  + NWA 
DO  430  L-l , NV 
KJ»K 
C-0. 

DO  440  KK-KL.NH, INC 
KJ=KJ  - 1 

440 

C=C  + A (KK)  *A  (KJ) 
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A (K)  =A  (K)  - C 
1*30  K=K  + NEQB 
C 

200  CONTINUE 
C 

c CARRY  OVER  INTO  TRAILING  BLOCKS 

DO  LOO  NK= 1 ,NTB 

IF  ( (NK+NJ)  .GT.NBLOCK)  GO  TO  LOO 
N I =N  1 

IF  ((NJ.EQ.1)  .OR.  (NK.EQ.NTB))  NI=NSTIF 

READ  (Nl)  B 

ML=NK*NEQB  + 1 

MR=MI NO ( (NK+1) *NEQB ,MI ) 

IF(MA.EQ.l)  ML=MR 
MD=MI  - ML 

KL=NEQB  + (NK-1) *NEQB*NEQB 
N=  1 
C 

DO  500  M=ML , MR 
NH=MAXA (M) 

KL=KL  + NEQB 
IF  (NH-KL)  505.510,510 
510  K=NEQB 
D=0 . 

DO  520  KK=KL , NH , I NC 
C=A  (KK)  / A (K) 

D=D  + C*A  (KK) 

A (KK)  =C 
520  K=K  - 1 

B(N)-B(N)  - D 
IF  (MD)  580,580,530 
530  I C=NEQB 

DO  5L0  J=1 , MD 
MJ=MAXA  (M+J)  - 1C 
IF  (MJ-KL)  5L0.550.550 
550  KU=MI NO  (MJ ,NH) 

KN=N  + 1C 
C=0. 

DO  575  KK=KL , KU , INC 
575  C=C  + A (KK) *A  (KK+I C) 

B(KN)=B(KN)  - C 
5L0  I C= I C + NEQB 
C 

58O  KN-N  + NWA 

K-NEQB  + NWA 
DO  610  L-l ,NV 
KJ*K 
C=0. 

DO  620  KK-KL.NH, INC 
C=C  + A (KK)  *A  (KJ) 

620  KJ=KJ  - 1 

B (KN)  =B  (KN)  - C 
KN=KN  + NEQB 
610  K=K  + NEQB 
C 
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505  MD=MD  - 1 

500  N=N  + 1 

C 

IF  (NTB.NE.l)  GO  TO  56O 
WRITE  (NRED)  A.MAXA 
DO  570  1=1, NAV 
570  A ( I ) =B  ( I ) 

GO  TO  600 

560  WRITE  (N2)  B 

C 

400  CONTINUE 

C 

M=N  1 
N 1 =N2 
N2=M 

590  WRITE  (NRED)  A.MAXA 

C 

600  CONTINUE 

C 

C VECTOR  BACKSUBST I TUT  I ON 

DO  700  K= 1 , NWVV 
700  B (K) =0 . 

REWIND  NL 
C 

DO  800  N J= 1 , NBLOCK 
BACKSPACE  NRED 
READ  (NRED)  A.MAXA 
BACKSPACE  NRED 
K=NEBT 

DO  810  L= 1 , NV 
DO  820  1=1, NEB 
B (K)  =B  (K-NEQB) 

820  K=K  - 1 

810  K=K  + NEBT  + NEB 

KN=0 
KK=NWA 
ND I F=NEQB 

IF  (NJ.EQ.l)  ND I F=NEQB  - (NBLOCK*NEQB  - NEQ) 
DO  855  L=1 ,NV 
DO  850  K= 1 , ND I F 
850  B (KN+K)  =A  (KK+K)  /A  (K) 

KK=KK  + NEQB 
855  KN-KN  + NEBT 

IF  (MA.EQ.l)  GO  TO  915 
ML-NEQB  + 1 
KL-NEQB 
DO  860  M-ML.MI 
KL=KL  + NEQB 
KU=MAXA  (M) 

IF  (KU-KL)  860,870,870 
K=NEQB 
KM=M 

DO  880  L=1 ,NV 
KJ=K 

DO  890  KK=KL , KU, INC 


870 
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890 

880 

860 


920 


91*0 

930 

910 

C 

915 


960 

950 

c 

800 

c 

1000 


1010 


c 


c 

c 

c 

c 


c 

c 


B (KJ)  =B  (KJ)  - A (KK)  *B  (KM) 

KJ=KJ  - 1 

KM=KM  + NEBT 

K=K  + NEBT 

CONTINUE 

N=NEQB 

DO  910  I =2 , NEQB 
KL=N  + INC 
KU=MAXA (N) 

IF  (KU-KL)  910,920,920 
K=N 

DO  930  L= 1 , NV 
KJ=K 

DO  940  KK=KL,KU, INC 
KJ=KJ  - 1 

B (KJ)  =B  (KJ)  - A (KK)  *B  (K) 
K=K  + NEBT 
N=N  - 1 


KK=0 

KN=0 

DO  950  L=1 ,NV 
DO  960  K= 1 ,NEQB 
KK=KK  + 1 
A (KK)  =B  (KN+K) 
KN=KN  + NEBT 


WRITE  (NL)  (A  (K)  , K=1  ,NWV) 
CONTINUE 


FORMAT  (//  46H  STOP  ***  ZERO  DIAGONAL  ENCOUNTERED  DURING, 
l8H  EQUATION  SOLUTION,  / 

13X.18H  EQUATION  NUMBER  =,  16  ) „„„„ 

FORMAT  (/  50H  WARNING  ***  NEGATIVE  DIAGONAL  ENCOUNTERED  DUR  , 

l8H  EQUATION  SOLUTION,  / * . 

1 3X , 1 8H  EQUATION  NUMBER  =,  16,  5X,  7HVALUE  =,  E20.O  ) 


RETURN 

END 

SUBROUTINE  SHELL 


CALLS?  TPLATE , STRSC 
CALLED  BY?  ELTYPE 


COMMON 

COMMON 

COMMON 

COMMON 

common 

common 


/ELPAR/  NPAR  (14) , NUMNP , MBAND .NELTYP ,N 1 ,N2,N3 » N4, N5.MT0T.NEQ 
/JUNK/  LT.LH.L, IPAD.SIG  (20)  , IF  ILL  (386) 

/EXTRA/  MODEX,NT8,N10SV,NT10, 1 F I LL2 (12) 

/say/  neqq.numee, loopur , nnblock.nterms, option 
/what/  naxa  (10000) , i rowl  (10000) , i col h (10000) 


IF  (NPAR  (1 ) . EQ.O)  GO  TO  500 
PROTECT  NODAL  TEMPERATURES 
N6=N5+NUMNP+1 2*NPAR  (3) 

IF  (N6.GT.MT0T)  CALL  ERROR  (N6-MT0T) 


C-Cp 


oooooooo 
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C 

N6-N5+NUMNP 

CALL  TPLATE  (NPAR  (2)  , NPAR  (3)  , A (Nl)  , A (N2)  ,A  (N3)  ,A  (NA)  ,A  (N6)  ,NUMNP, 
1 MBAND) 

C 

RETURN 

C 

500  WRITE  (6,2002) 

NUME=NPAR  (2) 

numee*nume 

neqq=neq 

DO  800  MM= 1 , NUME 

CALL  STRSC  (A  (Nl)  , A (N 3)  ,NEQ,0) 

WRITE  (6,2001) 

DO  800  L=LT, LH 

CALL  STRSC  (A  (Nl)  , A (N3)  ,NEQ,  1) 

WRITE  (6,3002)  MM, L,  (SIG(I)  , 1-1,6) 

C***  STRESS  PORTHOLE 
I F (N10SV.EQ. 1) 

*WRITE  (NT  10)  MM, L,  (SIG(I)  ,1-1,6) 

800  CONTINUE 
C 

RETURN 

C 

2001  FORMAT  (/) 

2002  FORMAT  (24H 1 SHELL  ELEMENT  STRESSES// 

1 ' ELEMENT  LOAD  MEMBRANE  STRESS  COMPONENTS 

2 BENDING  MOMENT  COMPONENTS',  / 

3 ' NUMBER  CASE  SXX  SYY  S 

M MXX  MYY  MXY 1 , //) 

3002  FORMAT  ( 10X, 2 I 10,6E 1 2 . 4) 

END 

C 

C CALLED  BY?  QTSHEL 
C 

C THIS  SUBROUTINE  FORMS  THE  PLATE  BENDING  STIFFNESS  AND/OR  THE 

C CONSISTENT  LOAD  VECTOR  OF  A LINEAR  CURVATURE  COMPATIBLE  TRIANGLE 

C (LCCT)  WITH  6,  5,  k OR  3 NODAL  POINTS 
C 


***************  INPUTS  **************** 


NUMBER  OF  MIDPOINT  DEGREES  OF  FREEDOM  (M  *3, 2, 1,0). 
NOTE..  MIDPOINTS  4-5-6  (IF  INCLUDED)  ARE  LOCATED  ON 
SIDES  2-3,  3-1  and  1-2,  RESPECTIVELY. 


C 

C 

C 

C 

c 

c 

c 

c 


KKK 


A ( I ) .BCD 


c (I  , J) 


OPERATION  FLAG 

KKK  LE  0 - FORM  STIFFNESS  MATRIX  AND  LOAD  VECTOR. 
KKK  GT  0 - FORM  LOAD  VECTOR  ONLY. 

1=1... 3 PROJECTIONS  OF  SIDES  2-3,  3-1  AND  1-2  ONTO 
X AND  -Y,  RESPECTIVELY. 

1=1. ..3,  J= 1 . . . 3 PLANE  STRESS  MATERIAL  MATRIX. 


o o r> 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


1=1. ..3  CORNER  THICKNESSES  (LINEAR  VARIATION  ASSUMED). 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PT(I)  1-1. ..3  CORNER  VALUES  OF  LATERAL  DISTRIBUTED  LOAD 

(LINEAR  VARIATION  ASSUMED). 

RMTfl  J)  |-1. ..3,  J=1 . . . 3 INITIAL  BENDING  MOMENT  COMPONENTS 
MOM-XX  (J=l),  MOM-YY  (J-2)  AND  MOM-XY  (J«3)  AT  THE 
CORNERS  1 = 1.  ..3  (LINEAR  VARIATION  ASSUMED). 


u A ^ * He  M * A A A A OUTPUTS  A A A A A A A A A A A A A A A A 


ST  (I  • J) 


FT  ( I ) 


1=1.. NDF,  J-1..NDF  WITH  NDF  (NUMBER  OF  DOF)  = 9+M>  ,s 
THE  ELEMENT  STIFFNESS  MATRIX  ASSOCIATED  WITH  THE  NODAL 


DISPLACEMENT  ORDERING 
W (1)  ,RX  (1)  t RY  (1)  ,W(2) 
WHERE  RM  (1)  i ...  RM(M)  , 
DEVIATIONS  FROM  NORMAL 


, RY  (3)  .RM(D  . •••  ™(M) 

IF  M GT  0,  ARE  MIDPOINT 
SLOPE  LINEARITY 


1=1.. NDF  CONSISTENT  NODAL  FORCE  VECTOR  ASSOCIATED 
WITH  THE  NODAL  DISPLACEMENT  ORDERING  DESCRIBED  ABOVE. 


SMT  (3 . 3) 


SLCCT  (M.KKK) 

ARG/  A (3)  . B (3)  > HMT  (3)  . H (3)  . C (3.3) 

FT  (1 2)  ■ PX(3)  ,PY  (3)  ,PT(3)  ,RM(3)  , ST  (1 2 , 1 2) 

p (2 1 , 1 2)  , G (21)  . Q (3.6)  • QB  (3.6)  , T (3)  . U (3)  . 
1 TX(3),  TY  (3)  > I PERM  (3).  XM  (3.3)  . XMO  (3) 

EQUIVALENCE  (CMll.C(l))  , (CM12,C(2))  . (CM13.C(3)) 

1 (CM23.C  (6) ) . (CM33.C(9)) 


SUBROUTINE 
COMMON  /TR 
1 BMT  (3 . 3)  . 
DIMENSION 


HT  (3) 


(CM22.C  (5) ) 


LOGICAL  NOS,  FLAT 
DATA  I PERM/2, 3.1/ 

HO  = (H(l)+H(2)+H(3))/3- 
IF  (HO.LE.O.)  GO  TO  1000 


NDF  = 9 + « 

NOS  = KKK.GT.O 

FLAT  = (H  ( 1 ) . EQ.H  (2) ) .AND.  (H  (2)  .EQ.H(3)) 
AREA  = A(3)*B(2)-A(2)*B(3) 

FAC  ■ HO**3*AREA/864 . 

PTF  = AREA/6480. 


T(3)  * 1. 

DO  150  I - 1.3 
J « 1 PERM  (I ) 

K = I PERM  (J) 

X - A (I)  **2+B  (I)  **2 
U ( I ) ■ - (A  (I ) *A  (J)+B  (I)  *B  (J) ) /X 

X -SQRT(X) 

Y = 2 .*AREA/X 
HT  ( I ) - 2 . *Y 

TX  ( I ) = Y*A(I)/X 
TY  (I)  * -Y*B  (I)  /X 
A 1 = A (I) /AREA 
A2  = A (J) /AREA 
B 1 - B (I) /AREA 
B2  = B (J)  / AREA 
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Q(l,  I)  = B1*B1 
Q (2,  I)  = A1*A1 
Q (3* I ) = 2.*A1*B1 

Q (1 , 1+3)  * 2.*B1*B2 
Q (2 , 1+3)  * 2.*A1*A2 
Q (3, 1+3)  = 2.*  (A1*B2+A2*B1) 

DO  120  N = 1,3 

120  XM(N.I)  = BMT(N,  l)*AREA/72. 

IF  (FLAT)  GO  TO  1 50 
DO  11*0  N * 1,3 
L - I PERM  (N) 

T (1)  = H(N)/HO 
T (2)  = H(L)/HO 

IF  (T(l).GT.O.)  XM  (N , I ) = XM  (N , I ) /T  (1)  **3 
Cl  = T (I ) 

C2  * T (J) 

C3  - T(K) 

C4  = C2+C3 
Cl  1 * C1*C1 
C23  = C2*C3 

C5  = Cb*  (3.*C1+C4)  + 6.*C11  - 2.*C23 
C6  = C5  + 3.*Cl**Cl*  - 1*.*(C1  1+C23) 

QB  (N , I ) = (Cl*  ( 10 . *c  1 1 - 3 . *C23)  +CJ+*C5) /1 7 .5  - 2.0 
11.0  QB  (N,  1+3)  = (C1*(C1  l-2.*C23)+Cl**C6)/35.0  - 1.0 
150  CONTINUE 

DO  200  1=1,3 

J = I PERM  ( I ) 

K - I PERM  (J) 


1 1 = 

3*1 

JJ  = 

3*J 

KK  = 

3*K 

A 1 = 

A ( 1 ) 

A2  = 

A (J) 

A3  « 

A (K) 

B 1 = 

B ( 1 ) 

B2  = 

B (J) 

B3  = 

B (K) 

U1  - 

U(l) 

U2  * 

u (J) 

U3  = 

U (K) 

W1  = 

1 .-Ul 

W2  = 

1 . -U2 

W3  = 

1 .-U3 

BID  = 

B 1 + 

Bl 

B2D  = 

B2  + 

B2 

B3D  = 

B3  + 

B3 

AID  = 

A 1 + 

A 1 

A2D  = 

A2  + 

A2 

A3D  = 

A3  + 

A3 

C21  = 

B1-B3*U3  + TX  (K) 

C22  = 

-B1D+B2*W2+B3*U3  + TX  (J) -TX  (K) 

C 3 1 - 

A1-A3*U3  + TY  (K) 

C22  = 

-B1D+B2*W2+B3*U3  + TX (J) -TX  (K) 

C31  = 

A1-A3*U3  + TY  (K) 

C 3 2 = 

-A1D+A2*W2+A3*U3  + TY  (J) -TY  (K) 

OLD  DOMINION  UNIVERSITY 


C5 1 = B3*W3-B2  + TX  (K) 

C52  = B2D-B3*W3'B1*U1  + TX  ( I ) -TX  (K) 

C6l  = A3*W3-A2  + TY  (K) 

C62  = A2D-A3*W3-A1*U1  + TY(I)-TY(K) 

C8l  = B3-B2D-B2*U2  + TX  (J) 

C8  2 = B1D-B3+B1*W1  + TX (I) 

C9 1 = A3-A2D-A2*U2  + TY  (J) 

C92  = A1D-A3+A1*W1  + TY  (I) 


pi  = PT  (I) *PTF 
P2  = PT  (J) *PTF 
P3  * PT(K)*PTF 

U37  = 7 .*U3 
W27  = 7 .*W2 
W24  = 4 . *W2 
U34  = 4.*U3 
Cl  = 54.+W27 
C2  = 54.+U37 
C3  = 15.+W24 
C4  = 39-+U37 
C5  = 39-+W27 
C6  = 15.+U34 
TXS  = TX  (J)  +TX  (K) 

FTS(  I ~-2)  (=  6™  (K(90  .+U37+W27)  *P  1+  (36  .+U37+W24)  *P2+  (36  .+U34+W27)  *P3) 
FT  (I  1-1)  = (C1*B2-C2*B3+7.*TXS)*P1  + (C3*B2-C4*B3+4 . *TXS+ 

1 }.*TX(K))*P2  + (C5*B2-C6*B3+4.*TXS+3-*TX(J))*P3 
Ft  (II)  = (Cl*A2-C2*A3+7 .*TYS) *P1  + (C3*A2-C4*A3+4 .*TYS+ 

1 3 . *TY  (K) ) *P2  + (C5*A2-C6*A3+4.*TYS+3.*TY(J))*P3 
FT  (K+9)  = (7.*  (P1+P2)+4.*P3)  *HT  (K) 

XMO(I)  = (XM  (1 , I ) +XM  (2,1)  +XM  (3 » I ) ) /3  - 
DO  200  N = 1,3 
L = 6*  (1-1)  + N 
Q1 1 = Q(N,  I) 

Q22  = Q (N , J) 

Q33  = Q(N,K) 

Q12  = Q (N , I +3) 

Q2 3 - Q(N,J+3) 

Q3 1 = Q(N,K+3) 

Q2333  = Q23-Q33 
Q31 33  = Q31-Q33 

P (l  ,11-2)  = 6.*(-QU+W2*Q33+U3*Q2333) 

P (L  ,11-1)  - C21*Q23+C22*Q33-B3D*Q12+B2D*Q31 

p (L  ,11  ) » C31*Q23+C32*Q33-A3D*Q12+A2D*Q31 

p (L  , J J-2)  - 6.*(Q22+W3*Q2333) 

p (l  , JJ- 1)  - C51*Q2333+B3D*Q22 
p (L  ,JJ  ) - C6l*Q2333+A3D*Q22 

P (L  , KK-2)  = 6.*(1  .+U2)  *Q33 
P (L  , K K — 1 ) - C8l*Q33 
P (L  , KK  ) = C9 1 *Q33 
P (L  , 1+9  ) * 0. 

P (L  , J+9  ) = HT(J)*Q33 

P (L  ,K+9  ) - HT  (K) *Q2333 
p (l+3  , 11-2)  = 6.*(Qll+U3*Q3133) 

P(L+3  ,M-1)  - C21*Q3133-B3D*QH 
p (l+3  ,ll  ) - C3l*Q3l33-A3D*QH 
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P (L+3  » J J-2)  = 6.*  (-Q22+U1*Q33+W3*Q3133) 

P (L+3  ,JJ-1)  = C51*Q31+C52*Q33+B3D*Q12-B1D*Q23 
P (L+3  ,JJ  ) = C6l*Q31+C62*Q33+A3D*Q12-AlD*Q23 
P(L+3  . KK-2)  = 6.  * (1  .+W1)  *Q33 
P (L+3  ,KK-D  = C82*Q33 
P (L+3  .KK  ) = C92*Q33 
P (L+3  , 1+9  ) = HT  ( l ) *Q33 
P (L+3  , J+9  ) =0. 

P (L+3  . K+9  ) = HT  (K) *Q3 133 
P (N+l8, I I -2)  = 2. * (Q 1 1+U3*Q12+W2*Q31) 

P (N+ 1 8 , KK- 1 ) = ( (B1D-B2D) *Q33+C82*Q23+C8l*Q31) /3. 

P (N+ 1 8 , KK  ) = ( (A1D-A2D) *Q33+C92AQ23+C91*Q31) /3. 
200  P(N+l8,K+9  ) = HT(K)*Q12/3. 

300  DO  400  J = 1 ,NDF 
DO  340  L = 1,3 
I I = L 
KK  = L + 18 
. P3  - P (KK , J) 

G (KK)  = 0. 

DO  340  N = 1,3 

I = I PERM  (N) 

JJ  = I I + 3 
PI  = P ( I I , J) 

P2  = P(JJ,J) 

SUM  = PI  + P2  + P3 
G 1 = SUM  + PI 
G2  = SUM  + P2 
G3  = SUM  + P3 
IF  (FLAT)  GO  TO  320 

G 1 = G 1 + QB  (N,  1)  *P1  + QB  (N , 6)  *P2  + QB(N,5)*P3 

G2  * G2  + QB  (N , 6)  *P  1 + QB(N,2)*P2  + QB(N,4)*P3 

G3  = G3  + QB  (N , 5)  *P  1 + QB  (N , 4)  *P2  + QB(N,3)*P3 

320  G (I  I)  - G1 

G (JJ)  = G2 
G (KK)  « G3  + G (KK) 

II  = II  +6 

340  FT  (J)  = FT  (J)  - XM  (N , L)  *G  1 - XM(I,L)*G2  - XMO  (L)  *G3 
IF  (NOS)  GO  TO  400 
DO  360  N - 1,19,3 
G 1 = G(N) 

G2  * G (N+l) 

G3  - G (N+2) 

G (N)  = CM11AG1  + CM1  2*G2  '+  CM13*G3 

G (N+l)  = CM12*G1  + CM22*G2  + CM23*G3 

360  G (N+2)  - CM1 3*G 1 + CM23*G2  + CM33*G3 

DO  390  I - 1,J 
X “ 0. 

DO  380  N - 1,21 
380  X *=  X + G (N)  *P(N,  I) 

X = X*F AC 
ST  ( I , J)  - X 
390  ST (J, I ) * X 
400  CONTINUE 
1000  RETURN 
END 
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C 
C 

c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 
c 


CALLED  BY?  QTSHEL 

THIS  SUBROUTINE  FORMS  THE  PLANE  STRESS  STIFFNESS  MATRIX  AND/OR 
THE  CONSISTENT  LOAD  VECTOR  OF  A LINEAR  STRAIN  TRIANGLE  O-ST)  WITH 
6,  5 OR  4 NODAL  POINTS,  OR  OF  A CONSTANT  STRAIN  TRIANGLE  (CST) . 
LINEAR  ELASTIC  ANISOTROPIC  MATERIAL 

I NPUTS  **************** 


*************** 
M 


NUMBER  OF  MIDPOINTS  INCLUDED  AS  NODAL  POINTS  (M-3,2.1 
FOR  LST , M=0  FOR  CST).  NOTE..  MIDPOINTS  4-5-6  ARE 
LOCATED  ON  THE  SIDES  2-3.  3" I AND  RESPECTIVELY. 


KKK 

A ( I ) ,B  (I) 

C (I  , J) 

H (I) 

PX  ( I ) ,PY(I) 
SMT  ( I ,J) 


OPERATION  FLAG  _ 

KKK  LE  0 = FORM  STIFFNESS  MATRIX  AND  LOAD  VECTOR. 

KKK  GT  0 = FORM  LOAD  VECTOR  ONLY. 

1 = 1. ..3  PROJECTIONS  OF  SIDES  2-3.  3~1  AND  1-2  ONTO 
X AND  -Y,  RESPECTIVELY. 

1=1. ..3,  J=1 . . . 3 PLANE  STRESS  MATERIAL  MATRIX. 

1=1. ..3  CORNER  THICKNESSES  (LINEAR  VARIATION  ASSUMED). 

1=1... 3 CORNER  VALUES  OF  X-Y  COMPONENTS  OF  BODY  FORCES 
PER  UNIT  OF  ELEMENT  AREA  (LINEAR  VARIATION  ASSUMED). 

1=1... 3,  J=1...3  INITIAL  MEMBRANE  STRESS  COMPONENTS 
SIG-XX  (J=l) , SIG-YY  (J=2)  AND  SIG-XY  (J=3  AT  THE 
CORNERS  1=1. 2, 3 (LINEAR  VARIATION  ASSUMED). 


***************  OUTPUTS  **************** 

cj(|  J)  1=1. .NDF,  J=1..NDF  WITH  NDF  (NUMBER  OF  DOF)  = 6+2*M,  I S 

S ’ THE  ELEMENT  STIFFNESS  MATRIX  ASSOCIATED  WITH  THE  NODAL 

DISPLACEMENT  ORDERING 

U(l)  ,V(1)  ,U(2)  ,V(2)  , U (3)  . .....  V(3+M) 

WHERE  U (4)  , ...  V (3+M)  . IF  M GT  0,  ARE  DEVIATIONS 
FROM  LINEARITY  AT  THE  MIDPOINTS  1...M. 


FT  (I) 


1=1.. NDF  CONSISTENT  NODAL  FORCE  VECTOR  ASSOCIATED 
WITH  THE  NODAL  DISPLACEMENT  ORDERING  DESCRIBED  ABOVE. 


SUBROUTINE  SLST  (M, KKK)  „ ,,  CMT,,  ,, 

COMMON  /TRIARG/  A(3).B(3).  H (3)  . HPT  (3)  , C. (.3, 3)*  3)  ’ 

1 BMT  (3,3)  , FT  (12),  PX  (3)  ,PY  (3)  »PT(3)  ,RM(3)  , ST  (12, 12) 
DIMENSION  Q (3, 3)  . QA  (3)  . QB  (3)  . A4  (3)  , B4  (3)  . I PERM  (3). 

EQUIVALENCE  (SXX  (1)  ,SMT  (1) ) , (SYY  (1)  ,SMT  (4) ) , (SXY  (1)  ,SMT  (7) ) 


LOGICAL  NOS 

DATA  IPERM  72,3,1/ 
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NOS  - KKK.GT.O 

NDF  = 6 + 2*M 

AREA  - A(3)*B(2)-A(2)*B(3) 

SUMH  - H(l)+H(2)+H(3) 

HO  = SUMH/3 . 

IF  (HO)  500,500,  HO 
140  PXS  = PX  ( 1 ) +PX  (2)  +PX  (3) 

PYS  - PY  ( 1 ) +PY  (2)  +PY  (3) 

SXXH  = 0. 

SYYH  = 0. 

SXYH  = 0. 

DO  150  I = 1,3 
CH  = (SUMH+H  (l))/24. 

SXXH  = SXXH  + CH*SXX(I) 

SYYH  = SYYH  + CH*SYY  (I) 

150  SXYH  * SXYH  + CH*SXY(I) 

FAC  = H0/(2.*AREA) 

Cl  1 - C (1 , 1) *FAC 
C22  = C(2,2)*FAC 
C33  = C(3,3)*FAC 
C 1 2 = C (1 ,2) *FAC 
C 1 3 = C (1 , 3)  *FAC 
C2 3 = C (2 , 3)  *F  AC 
DO  200  J = 1 , 3 
L = J + J 

FT(L-l)  = (PXS+PX  (J) ) *AREA/24  . - (B  (J)  *SXXH+A  (J)  *SXYH) 
FT  (L)  = (PYS+PY  (J) ) *AREA/24.  - (A  (J)  *SYYH+B  (J)  *SXYH) 

IF  (NOS)  GO  TO  200 
180  DO  190  I - l.J 
K « I + I 
AA  = A(I)*A  (J) 

BB  = B (I)  *B  (J) 

AB  = A(I)*B(J) 

BA  = B(I)*A(J) 

ABA  = AB+BA 

ST(K-I.L-l)  = C 1 1 *BB  + C33*AA  + C13*ABA 
ST  (K  , L ) = C22*AA  + C33*BB  + C23*ABA 

ST  (K- 1 , L ) = C12*BA  + C33*AB  + C13*BB  + C23*AA 

190  ST  (K  , L- 1)  = C12*AB  + C33*BA  + C13*BB  + C23*AA 

200  CONTINUE 

IF  CM)  350,350,220 
220  DO  240  |«1,3 

A4  ( I ) - 4.*A(I) 

B4  ( I ) - 4.*B  (I) 

J - I PERM  (I ) 

K - I PERM  (J) 

R * H ( I ) /HO 
Q ( I . I ) - 0. l+R/15. 

Q (J , K)  - 0.1-R/60. 

240  Q (K, J)  - Q (J , K) 

DO  300  J - 1 ,M 
J1  = I PERM  (J) 

J2  = I PERM  (J  1) 

L — J + J + 6 
FX  = 0. 
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FY  = 0. 

DO  250  N = 1 ,3 
Q 1 = Q (N , J 1) 

Q2  * Q (N , J2) 

QA  (N)  = Q2*A4  (J1)+Q1*A4  (J2) 

QB  (N)  * Q2*B4  (J1)+Q1*B4  (J2) 

FX  = FX  - QB(N)*SXX(N)-QA(N)*SXY(N) 

250  FY  = FY  - QA  (N)  *SYY  (N)  -QB  (N)  *SXY  (N) 

FT(L-l)  = (PXS-PX(J))*  AREA/12.  + FX*H0/2. 

FT  (L)  = (PYS-PY  (J))*AREA/12.  + FY*H0/2. 

IF  (NOS)  GO  TO  300 
SUMQA  = QA  (1)  +QA  (2)  +QA  (3) 

SUMQB  = QB  (1)+QB  (2)+QB  (3) 

JM  = J + 3 
DO  290  I = 1 , JM 
K = I + I 

IF  (I  . GT . 3)  GO  TO  260 
AA  = A (I) *SUMQA 
AB  = A(I)*SUMQB 
BA  = B ( I ) *SUMQA 
BB  = B(l)  *SUMQB 
GO  TO  280 

260  11  = I PERM  (1-3) 

12  = I PERM  ( I 1) 

AA  = A4(I2)*QA(I  1)+A4(I  1)*QA(I2) 

AB  = A4(I2)*QB(I1)+A4(I  1)*QB(I2) 

BA  = B4(I2)  *QA(I  1)+B4  (I  1)  *QA  (12) 

BB  = B4  (I  2)  *QB  (I  1)+B4  (I  1)  *QB  (I  2) 

280  ABA  = AB+BA 

ST(K-l.L-l)  = Cl  1 *BB  + C33*AA  + C13*ABA 

ST(K  , L ) = C22*AA  + C33*BB  + C23*ABA 

ST  (K-  1 , L ) = C12*BA  + C33,,fAB  + C 1 3*BB  + C23*AA 

290  ST  (K  , L — 1 ) = C12*AB  + C33*BA  + C13*BB  + C23*AA 

300  CONTINUE 
350  DO  400  I = 2 ,NDF 
DO  400  J = 1 , I 
400  ST  (I  , J)  = ST  (J,  I) 

500  RETURN 
END 

SUBROUTINE  SOLEIG 
C 

c CALLS?  MODES, PRINTD 

C CALLED  BY?  MAIN 

C 

C SOLUTION  OF  THE  EIGENVALUE  PROBLEM 

C 

COMMON  /one/  A(l) 

COMMON  /ELPAR/  NP (14) , NUMNP , MBAND , NELTYP ,N1 ,N2,N3.N4,N5»MT0T,NEQ 
COMMON  /SOL/  NBLOCK ,NEQB,LL,NF,I DUM.NE I G ,NAD ,NVV, ANORM, NFO 
COMMON  /EM/  AT(IOOO)  , IFILL1  (3138) 

COMMON  /EXTRA/  MODEX , NT8 , I F I LL2  (1 4) 


C 


REAL  TT  (3) 
NT  = 7 
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C READ  CONTROL  CARD 
C 

C***  CALL  TTIME  (TT ( 1 ) ) 

WRITE  (6,1003) 

READ  (5,100)  IFPR, I FSS , N I TEM, RTOL , COFQ.NFO 
C 

IF  ( I FPR.GT.O)  IFPR-1 
IF  (IFSS.GT.O)  IFSS-1 
IF  (NITEM.EQ.O)  NITEM=16 
IF  (RTOL.EQ.O.)  RT0L-1.E-05 
IF  (COFQ.EQ.O.)  C0FQ=1.E08 
C 

IF  (NEIG.GT.O)  GO  TO  10 
C 

WRITE  (6,1001) 

GO  TO  15 

10  WRITE  (6, 1002) 

15  WRITE  (6,1000)  IFPR, IFSS.NITEM, RTOL, COFQ.NFO 
20  IF  (MODEX.EQ.l)  RETURN 
TPI=8.0D0*ATAN (1 .ODO) 

COFQ=COFQ*TP I 
COFQ=COFQ*COFQ 
C 

C CALL  SOLUTION  ROUTINE 
C 

CALL  MODES  (NEQ, MBAND , NBLOCK , NEQB , NF , MTOT, I F PR, I FSS , RTOL , N I TEM, 
1C0FQ) 

C 

C***  CALL  TTIME  (TT  (2) ) 

C 

C WRITE  CONTROL  INFORMATION  ON  TAPE  — FOR  RESTART  OPTION 
C 

NC=2 

REWIND  NC 

WRITE  (NC)  NEQ, NBLOCK, NEQB, MBAND, Nl, NF,  (AT(I) ,1  = 1, NF) 

C 

C PRINT  OF  EIGENVALUES  (OMEGA)  AND  EIGENVECTORS 
C 

REWIND  NT 

READ  (NT)  (A  (I)  , 1 = 1, NF) 

K-NF+1 

DO  30  1=1, NF 
K=K- 1 

KK= (K- 1) *3+1 
A (KK)=A  (K) 

A (KK+1)  *A  (K)  /TP  I 
30  A (KK+2)  *TP  I /A  (K) 

IF  (NEIG.GT.O)  GO  TO  25 
WRITE  (6,1009) 

DO  1*1  1=1 , NF 
K 1=3* I -2 

K2=3*l 

41  WRITE  (6,1020)  I , (A  (J) , J=K 1 , K2) 

GO  TO  35 

25  WRITE  (6,1010) 
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DO  40  I =1 , NF 
K 1=3* I -2 
K2=3*l 

40  WRITE  (6,1020)  I , (A  (J)  , J=K 1 , K2)  , AT  (NF+I ) 

C 

35  N 1=1 

N2=N1+NUMNP*6 

N3=N2+6*NF 

CALL  PRINTD  (A  (N 1 ) , A (N2)  , A (N3) , NEQB , NUMNP ,NF , NBLOCK, NEQ, NT , 2) 

C***  CALL  TTIME  (TT  (3) ) 

C 

C COMPUTE  TIME  LOG 
C 

DO  50  K=1 ,2 

50  TT  (K)  = TT  (K+l ) -TT  (K) 

WRITE  (6,2000)  (TT  (L)  ,L=1  ,2) 

C 

100  FORMAT  (31 5»2F 10.0, 15) 


1000  FORMAT 
1 
2 

3 

4 

5 

6 

7 

8 

9 


A 

B 

1001  FORMAT 

1002  FORMAT 

1003  FORMAT 

1009  FORMAT 
1 

2 

3 

1010  FORMAT 
1 

2 

3ERANCE 

4 

1020  FORMAT 
1030  FORMAT 
2000  FORMAT 
1 
2 


( 1 HO  //  20H  CONTROL  INFORMATION,  // 

5X , 3 1 HF LAG  FOR  ADDITIONAL  PRINTING 
7X.14HEQ.O,  SUPPRESS,  / 

7X.11HEQ.1,  PRINT,  // 

5X , 3 1 HSTURM  SEQUENCE  CHECK  FLAG  (*) 
7X.19HEQ.O,  PERFORM  CHECK,  / 

7X.10HEQ.1,  PASS,  // 

5X , 3 1 HMAX I MUM  ITERATION  CYCLES  (*) 

5X , 3 1 HCONVERGENCE  TOLERANCE  (*) 

5X , 3 1 HCUT-OF F FREQUENCY  (CPS) 

5 X , 3 1 HNUMBER  OF  STARTING  ITERATION 
5X , 3 1 HVECTORS  TO  BE  READ  FROM 
5X, 31HTAPE10  (*) 

5X , 27H  (*)  APPLICABLE  TO  SUBSPACE, 

5X.29H  ITERATION  SOLUTIONS  ONLY,  IX) 

(44H0DETERM I NANT  SEARCH  SOLUTION  IS  CARRIED 
(44H0SUBSPACE  ITERATION  SOLUTION  IS  CARRIED 
(1H1 ,//4lH  EIGENVALUE  ANAL 
(1H1 , ' 20HPRINT  OF  FREQUENCIES',// 


(1 H 1 


9 

15  / 

f 

15  / 

“ * 

15  // 

“ 9 

E 1 4 . 4 

// 

= | 

E14.4 

// 

* 

/ 

* 

/ 

= I 

15 

/// 

/ 


Y S 


OUT 
OUT 
I S 


//) 


23H  MODE 

CIRCULAR 

/ 

PERIOD'  ,/ 
(SEC)  ') 

49H  NUMBER 

FREQUENCY 

FREQUENCY 

49H 

(RAD/SEC) 

(CYCLES/SEC) 

PRINT  OF  FREQUENCIES' ,// 
23H  MODE  CIRCULAR 

',/ 

PERIOD 

58H  NUMBER 

FREQUENCY 

FREQUENCY 

49H 

(RAD/SEC) 

(CYCLES/SEC) 

(SEC)  ' 

TOL 


/ 


(1H0, 1 4 , 6X , 4 (E10.4.2X)) 

(///  22H  PRINT  OF  EIGENVECTORS,  //  IX) 

(////  44H  EIGENSOLUTION  TIME  LOG, 
//5X, 15HE IGENSOLUTION  =,  F8.2  / 

5X, 15HPRINTING  =,  F8.2  /) 


C 


RETURN 

END 
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C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


c 

c 

c 


c 


SUBROUTINE  SOLSTP  ( I D I S , I STR , MASS , B , XO, XI , X2 , A, MAXA , SD I S , SSTR , 

1 nsd,nss,neq,neqb,mband,nwa,mi ,mm, nblock) 

REAL  MASS 

CALLS?  REDVK 
CALLED  BY?  STEP 

THIS  ROUTINE  SOLVES  FOR  DISPLACEMENTS.  VELOCITIES  AND  ACCELERA- 
TIONS AT  EACH  SOLUTION  TIME  STEP  AND  SAVES  ONLY  THOSE  DISPLACEMENT 
COMPONENTS  REQUIRED  FOR  EITHER  HISTORY  PRINTING  OR  STRESS  HISTORY 
RECOVERY. 

*TAPE2*  CONTAINS  LOAD  VECTORS  FOR  EACH  TIME  STEP 
*TAPE3*  CONTAINS  THE  REDUCED  EFFECTIVE  STIFFNESS  MATRIX 
IN  BLOCK  FORM 

*TAPE4*  USED  TO  SAVE  DISPLACEMENTS  FOR  HISTORY  OUTPUT  *JT* 

*TAPE7*  USED  TO  SAVE  DISPLACEMENTS  FOR  STRESS  RECOVERY  *IT* 

IDIS(NSD)  , ISTR(NSS)  .MASS  (NEQ)  , B (NEQ)  ,XO(NEQ)  , 

XI  (NEQ)  , X2  (NEQ)  ,A(NWA)  .MAXA  (Ml)  , SD  I S (MM,  NSD)  . 

SSTR  (MM, NSS)  , I SAVE  (3) 

NT, NOT, ALFA, DELT, BETA, IFILL1  (4) 

COMMON  /EXTRA/  MODEX , NT8 , N 1 OSV, NT  1 0 , I F I LL2 ( 1 2) 

SET  TAPE  ASSIGNMENTS 

JT  = 4 
IT  = 7 
KT  = 2 


DIMENSION 

1 

2 

COMMON  /DYN/ 


REWIND  JT 
REWIND  KT 
REWIND  IT 
REWIND  NT  1 0 
C 

C SET  FLAGS  FOR  SAVING  SYSTEM  (D I S/VEL/ACC)  VECTORS 
C 

I = NIOSV 
L = 4 

DO  50  K-1,3 
L - L-1 

ISAVE  (L)  - I - 1/10*10 
50  I - 1/10 
C 

C CLEAR  SYSTEM  VECTORS  (I.E.,  ZERO  INITIAL  CONDITIONS  ASSUMED) 


DO  100  1-1, NEQ 
X0(l)-0.0 
XI  (l)=0.0 
100  X2  (I ) -0 .0 
C 

C COMPUTE  THE  TIME  CONSTANTS  FOR  INTEGRATION 
C 

TETA-1 .4 
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DELT1 =TETA*DELT 
DELT2=DELT1**2 

AO=(6.+3-*ALFA*DELTl) / (DELT2+3.*BETA*DELT1) 

BO=ALFA-BETA*AO 

A1=6./DELT2+3.*B0/DELT1 

A2-6 ./DELT1+BO+BO 

A3=2.+BO*DELTl/2. 

A4=6./  (3.*BETA*0ELT1+DELT2) /TETA 
B1=BETA*A4 

A5=3.*Bl/DELTl-6./DELT2/TETA 

a6=2.*bi-6./delti/teta 
A7-.5*B1*DELT1+1 .-3. /TETA 
A8=0 . 5*DELT 
A9=DELT**2/3-0 
A10=0.5*A9 
c 

c TIME  STEP  LOOP 

c 

I K=0 


C 

DO  700  K=1 , NT 

C READ  THE  VECTOR  OF  APPLIED  FORCES  AT  THIS  SOLUTION  STEP 
C 

READ  (KT)  B 
C 

C COMPUTE  THE  EFFECTIVE  LOAD  VECTOR 

C 

DO  450  1-1, NEQ 

450  B (I)  =B  (D+MASS  (I)  * (A  1 *XO  ( I ) +A2*X  1 (l)+A3*X2  (I)) 

C 

C SOLVE  FOR  DISPLACEMENT  VECTOR 

Q 

CALL  REDVK  (A , B , MAX A , NEQB , NWA ,NEQ,NBLOCK ,MI .MBAND, K) 


C 

C COMPUTE  DISPLACEMENTS  *XO* 

C VELOCITIES  *xi* 

C ACCELERATIONS  *X2* 

C 

DO  500  1=1 ,NEQ 
ACC=A4*B  ( I ) +A5*XO  ( I ) +A6*X 1 (l)+A7*X2  (I) 

XO(I)=XO(I)+OELT*X1  (l)+A9*X2  (l)+A10*ACC 
XI  (I)  -XI  (I ) +A8*  (X2  ( I ) +ACC) 

500  X2  (I ) -ACC 

C PERFORM  TAPE  SAVE  OPERATIONS  ON  SYSTEM  VECTORS  AT  TIME  STEP 
C 

IF  (NIOSV.LT. 1)  GO  TO  520 


* 

* AT  TIME  STEP  *K* 

* 


I F (ISAVE  (1)  .LT.  1)  GO  TO  510 
I = K -K/ 1 SAVE  (1)  * | SAVE  (1) 

IF  (I  . EQ.O) 

*WRITE  (NT  10)  XO 
510  I F (I  SAVE  (2)  .LT.  1)  GO  TO  515 
I = K — K/ 1 SAVE  (2)  * I SAVE  (2) 


K. 
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IF  (I .EQ.O) 

*WR I TE  (NT10)  XI 
515  IF  (ISAVE (3)  . LT . 1 ) GO  TO  520 
I = K -K/ 1 SAVE (3) *1  SAVE  (3) 

I F (I  .EQ.O) 

*WRITE  (NT10)  X2 
C 

520  CONTINUE 
C 

C TEST  TO  SEE  IF  DISPLACEMENTS  ARE  TO  BE  SAVED  FOR  PRINTING  OR 
C ELEMENT  STRESS  RECOVERY 
C 

L = K - K/NOT*NOT 
I F (L.NE.O)  GO  TO  700 
I K= I K+l 

IF (NSO.LT. 1)  GO  TO  610 
DO  600  1=1 ,NSD 
J-IDIS  (I) 

600  SDIS (I K, I) =X0  (J) 

610  IF (NSS.LT. 1)  GO  TO  660 
DO  650  1=1 ,NSS 
J= I STR ( I ) 

650  SSTR  (IK, I ) =X0  (J) 

660  IF  (IK.NE.MM)  GO  TO  700 
I K=0 

IF(NSD.GT.O)  WRITE  (JT)  SDIS 
I F (NSS.GT.O)  WRITE  (IT)  SSTR 
C 

700  CONTINUE 
C 

C END  OF  TIME  MARCHING  LOOP 

C 

IF  (IK. EQ.O)  RETURN 
IF(NSD.GT.O)  WRITE  (JT)  SDIS 
IF  (NSS.GT.O)  WRITE  (IT)  SSTR 
C 

RETURN 

END 

SUBROUTINE  S0L21 
C 

C CALLED  BY  ? ELTYPE 

C CALLS  ? STRSC 

C 
C 

C 3 / D 8 TO  21  NODE  SOLID  ELEMENTS 
C 

COMMON  /ELPAR/  NPAR(H»)  .NUMNP.MBAND.NELTYP.Nl  ,N2,N3,NJt,N5,MT0T,NEQ 
COMMON  /EM/  NS,ND,LM(63) 

COMMON/JUNK/  LT , LH, L.N6.S I G (42) ,N7,N8,N9,N10,N1 1 , N 1 2 , N 1 3 , N 1 4 , 

1 N15.N16.N17 

COMMON  /EXTRA/  M0DEX.NT8.N10SV.NT10 
common  /say/  neqq.numee, loopur.nnb lock, nterms, opt  ion 
common  /what/  naxa  (10000) , i row  I (10000) , i col h (10000) 

C 

COMMON  /one/  A(l) 
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C 

C 

C 

C 

C 


IF  (NPAR(l)  . EQ.O)  GO  TO  500 

ERROR  CHECKS  AND  SET  DEFAULT  VALUES  IF  REQUIRED 


WRITE  (6,1000) 

IF  (NPAR(2)  .GT.O)  GO  TO  10 
WRITE  (6,1001)  (NPAR  (K)  ,K=1 , 10) 
WRITE  (6,1002) 

STOP 

I F (NPAR  (3)  .GT.O)  GO  TO  20 
WRITE  (6,1001)  (NPAR  (K)  ,K=1 , 10) 
WRITE  (6,1003) 

STOP 

IF  (NPAR  (4)  .EQ.O) 

IF  (NPAR  (7)  .EQ.O) 

IF  (NPAR  (7)  .GE  .8 


NPAR  (4)  = 1 
NPAR  (7)  = 21 

.AND.  NPAR (7) -LE .21)  GOTO  30 


(6,1001) 

(6, 1004) 


(NPAR  (K)  , K=  1 ,10) 


WRITE 
WRITE 
STOP 

I F (NPAR  (9)  .EQ.O)  NPAR  (9)  = 2 
IF  (NPAR(9)  .GE.2  .AND.  NPAR  (9)  • LE  . 4) 
WRITE  (6, 1001)  (NPAR (K)  , K= 1 , 1 0) 

WRITE  (6,1005) 

STOP 

I F (NPAR  (10)  .EQ.O)  NPAR(IO)  = 2 
IF  (NPAR(IO)  .GE.2  .AND.  NPAR  (10)  . LE  .4) 
WRITE  (6,1001)  (NPAR  (K)  . K— 1,10) 

WRITE  (6,1005) 

STOP 


GO  TO  40 


GO  TO  50 


C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


STORAGE  ALLOCATION 


A (N6)  = 
A (N  7 ) = 
A (N8)  = 

A(N9)  = 
A (N 10) 

A (N1 1) 

A (N 1 2) 

A (N 1 3) 

A (N 1 4) 

A (N 1 5) 

A (N 1 6) 


STARTING  LOCATION  OF  WEIGHT  DENSITY 
STARTING  LOCATION  OF  MASS  DENSITY 
STARTING  LOCATION  OF  VECTOR  CONTAINING 
NUMBER  OF  TEMPERATURE  POINTS  FOR  EACH 
STARTING  LOCATION  OF  MATERIAL  PROPERTY 
= STARTING  LOCATION  OF  DIRECTION  COSINE 
ORIENTATION 
LOCATION  OF 


THE  ACTUAL 
MATERIAL  TABLE 
TABLE 

ARRAYS  FOR 


AXIS 

SURFACE  LOAD  FACE  NUMBERS 
SURFACE  LOAD  CODE  TYPES 
PRESSURE  WORKING  ARRAY 
OUTPUT  REQUEST  LOCATION  SETS 
VECTOR  CONTAINING  THE  ACTUAL 
NUMBER  OFREQUESTED  OUTPUT  LOCATION  IN  EACH  OUTPUT 
STARTING  LOCATION  OF  ELEMENT  STIFFNESS  MATRIX 


MATERIAL 
STARTING 
STARTING 
STARTING 
STARTING 
STARTING 


LOCATION 

LOCATION 

LOCATION 

LOCATION 


OF 

OF 

OF 

OF 


SET 


50  N6  - N5  + NUMNP 
N7  - N6  + NPAR  (3) 

N8  * N7  + NPAR  (3) 

N9  = N8  + NPAR  (3) 

N10  = N9  + NPAR  (3)  * NPAR  (4)  * 13 
Nil  - N 10  + NPAR  (5)  * 9 
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NI2  = Nil  + NPAR(6) 

N 1 3 = N12  + NPAR  (6) 

N 1 4 = N 1 3 + NPAR  (6)  * 7 
N 1 5 = NIL  + NPAR  (8)  A 7 
N 1 6 = N 1 5 + NPAR  (8) 

N 1 7 = Nl6  + NPAR  (7)  * 189 
C 

I F (N1 7 .GT.MTOT)  CALL  ERROR (N 1 7-MTOT) 

C 

C PROCESS  ELEMENT  DATA,  AND  GENERATE  ELEMENT  MATRICES 
C 

CALL  THDFE  (A  (N  1 ) ,A(N2)  ,A(N3)  . A (N4)  ,A(N5)  ,A(N6)  ,A(N7)  ,A(N8)  ,A(N9)  , 

1 A (N 1 0)  , A (N 1 1 ) , A (N 1 2)  , A (N 1 3)  , A (N  H)  , A (N 1 5)  , A (N 1 6)  , 

2 NPAR  (2)  , NPAR  (3)  , NPAR  (4)  , NPAR  (5)  , NPAR  (6)  .NPAR  (7)  , 

3 NPAR  (8)  , NPAR  (9)  , NPAR  (10)  ,NUMNP) 

C 

RETURN 

C 

C RECOVER  ELEMENT  STRESSES  (STATIC  CASES  ONLY) 

C 

500  WRITE  (6,2001) 

NUME  = NPAR  (2) 

C 

DO  800  MM= 1 , NUME 
C 
C 

C***  STRESS  PORTHOLE 

CALL  STRSC  (A  (Nl)  , A (N3)  ,NEQ,0) 

I F (N10SV.EQ.  1) 

*WRITE  (NT10)  NS 

C*rt* 

c 

I F (NS.EQ. 1)  GO  TO  800 
C 

WRITE  (6,5000) 

C 

DO  700  L=LT, LH 
C 
C 

CALL  STRSC  (A  (N 1 ) ,A(N3)  ,NEQ,  1) 

LOC  = NS/6 
K 1 * -5 
C 

DO  600  N-l.LOC 
K 1 * K 1 +6 
K2  - K1  + 5 
C 

IF(N.EQ.l)  WRITE  (6,3001)  MM,  L , N , (S  I G (I ) , I «K1 , K2) 

IF(N.GT.l)  WRITE  (6,4001)  N,  (S  I G (I ) , l-Kl  ,K2) 

C 

C***  STRESS  PORTHOLE 
IF (N10SV.EQ. 1) 

AWRITE  (NT10)  MM,L,N, (SIG(I) , I-K1.K2) 

CA** 

600  CONTINUE 
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WRITE  (6,5000) 

700  CONTINUE 
800  CONTINUE 
RETURN 


C 

C 

c 


1000 

1001 

1002 

1003 

1004 

1005 
2001 


FORMATS 

FORMAT  (53H121  -NODE  SOLID  ELEMENT  INP  U T 
1 1 OH D A T A .//38HOCONTROL  INFORMATION  */,w 

FORMAT  (48HOERROR  DETECTED  WHILE  PROCESSING  MASTER  ELEMENT  , 

1 1 2HC0NTR0L  CARD ,//l6X, 1H  (, 10 1 5. 1H) ,/l X) 

(32H  NO  3/D  SOLID  ELEMENTS  SPEC! F I ED, /IX) 

(23H  NO  MATERIALS  REQUESTED,  / IX) 

(49H  MAXIMUM  NUMBER  OF  NODES  MUST  BE  GE.8 
NTEGRAT I ON  ORDER  MUST  BE  GE.2  .AND. 


FORMAT 

FORMAT 

FORMAT 

FORMAT 

FORMAT 


(42H  - „ „ 

(54H121  -NODE  SOLID  ELEMEN 


.AND.  LE.21./1X) 
LE.4./1X) 

T STRESS 


3001 

4001 

5000 


23H  ELEMENT  LOAD  LOCAT I ON , 9X, 6HS I G-XX , 9X , 6HS I G-YY , 9X , 6HS I G-ZZ, 
5 9X.6HSI G-XY.9X.6HS  I G-YZ.9X.6HS  I G-ZX,// IX) 

FORMAT  (l8, 16, I9.6E15-6) 

FORMAT  ( 14X, I9.6E15-6) 

FORMAT  ( / ) 


END 

SUBROUTINE  SPECTR 


(F.PX.XM.W.MASS.NEQB.NF .NBLOCK.TM) 


C 

C 

C 

C 


C 

C 

c 


c 

c 

c 

c 


CALLS?  SD 
CALLED  BY?  RESPEC 


COMMON  /EXTRA/  MODEX , NT8 , I F I LL  ( 1 4) 

DIMENSION  PX(NF,3)  ,F  (NEQB.NF)  .XM(NEQB)  ,W(NF) 
DIMENSION  DIRN(3) 


.MASS  (NEQB) 


COMPUTES  MODAL  AND  R.M.S.  DISPL  RESPONSE  TO  EARTHQUAKE 


IF  (MODEX. EQ.l)  GO  TO  270 
TP  I =6 . 2831853 
DO  100  1=1, NF 
DO  100  J=1 , 3 
100  PX  ( I , J) =0 . 


FORM  MODAL  PARTICIPATION 
I DRN=1 ,2,3 F0R 


FACTORS  PX  (I , I DRN) 
X,Y,Z,  DIRN  EARTHQUAKE 


REWIND  9 
REWIND  3 

DO  200  N=1 , NBLOCK 
BACKSPACE  7 
READ  (7)  F 
BACKSPACE  7 
READ  (3)  MASS 
READ  (9)  XM 


C 
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DO  250  1=1 , NEQB 
J=MASS (I) 

IF  (J.LE.O)  GO  TO  250 
DO  2 1+0  L=1 , NF 

240  PX(L,J)-PX  (L,J)+F  (I  ,L)*XM(I) 

250  CONTINUE 
200  CONTINUE 
C 

c READ  FREQUENCIES  W OFF  TAPE  7 
C 

BACKSPACE  7 
READ  (7)  W 
REWIND  2 
WRITE  (2)  W 
C 

C COMPUTE  MODAL  AMPLITUDES  ( I N W)  FROM  SPECTRUM  AND  PX 
C 

270  READ  (5,1000)  DIRN.IND 
WRITE  (6,2000)  DIRN 
WRITE  (6,2010)  IND 
IF  (MODEX.EQ.l)  W(1)-SD(1) 

IF  (MODEX.EQ.l)  RETURN 
WRITE  (6,2020) 

DO  280  1-1 , NF 

280  WRITE  (6,2040)  I , (PX  (I  , J)  , J-l , 3) 

DO  300  1=1 , NF 
WW=TP I /W  ( I ) 

WR-O. 

DO  290  K-1 ,3 

290  WR-WR  +ABS  (PX  ( I , K) ) *D I RN  (K) 

WR-WRASD (WW) 

IF  (IND.  EQ.  1)  WR-WR/  (W(I)*W(I)) 

300  W ( I ) =WR 
C 

C WRITE  MODAL  DISPLS  F AND  R.M.S.  ON  TAPE  2 
C 

REWIND  7 
READ  (7) 

DO  350  N=1 , NBLOCK 
READ  (7)  F 
DO  310  J-l ,NF 
AMP-W  (J) 

DO  310  1-1, NEQB 
310  F (I , J)  -F  (I ,J) *AMP 
C 

DO  320  1-1 , NEQB 
WW-O. 

DO  330  J-l.NF 
330  WW-WW+F (I , J) **2 
320  XM(I)-SQRT(WW) 

350  WRITE  (2)  F , XM 

RETURN 

1000  FORMAT  (3F10.0, 1 5) 

2000  FORMAT  (20H  DIRECTION  FACTORS  / / 
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1 10X.3HX  = F10.4.4X.3HY  = F10.4,4X,3HZ  = F10.4 

2010  FORMAT  (5&H0 I ND I CATOR  FOR  DISPLACEMENT  OR  ACCELERATION 

1 15  // 

2 20H  EQ.O  DISPLACEMENT  / 

3 20H  EQ.1  ACCELERATION  ///) 

2020  FORMAT  (28H  MODAL  PARTICIPATION  FACTORS,  //  5H 

1 1 1HX-D IRECTION, 3X, 1 1HY-DI RECTION, 3X, 1 1HZ-DIRECTI0N,  / 

2040  FORMAT  (1H  ,I4,3E14.4  / IX) 

END 

SUBROUTINE  SPLOT  (IT, JT.NDS, I SP) 


C 

c 

c 

c 

c 

c 

c 


c 

c 


CALLED  BY?  SDSPLY 

ROUTINE  TO  PRODUCE  PRINTER  PLOTS  OF  TIME  HISTORIES, 
EIGHT  (MAXIMUM)  TRACES  PER  PLOT. 


COMMON  /EM/  PP(101)  ,KD(2,8)  ,XM(8)  ,TM(8)  ,IP(8)  ,X(8)  , 

COMMON  /DYN/  NT ,NOT , DAMP , DT , BETA , I F I LL2  (4) 


DIMENSION  SM  (8) 


DATA 

DATA 


SM/1H1,1H2,1H3.1H4,1H5.1H6.1H7.1H8/ 
BL/1H  /,V/1HX/,AST/1H*/ 


C 


READ  (IT)  KD , XM.TM, L 

WRITE  (6,3000)  (KD  (1 , I)  ,KD  (2, I) 


, XM  ( I ) ,TM  (I ) , I , 1-1,  L) 


DO  100  1=1, L 
I F (XM  ( I ) ) 50,100,50 
50  XM  ( I ) =50 ./XM ( I ) 

100  CONTINUE 
TT=0 . 

WRITE  (6,999) 

WRITE  (6,1000) 

WRITE  (6,2000)  TT,  (V, 1 = 1,101) ,TT 


K=1 

DO  200  1=2, 100 
200  PP  ( I ) =BL 


C 

c 

c 


c 


CONSIDER  EACH  OUTPUT  STEP 

DO  500  N=1 , NDS 
READ  (JT)  X 
PP(1)=V 
PP  (51)  “V 
PP(101)=V 

220  I 1 = 1 SP 

210  IF  (I  I . LE  .0)  GO  TO  250 
WRITE  (6,2001)  PP 
11=11-1 
GO  TO  210 


C 


//) 

SPECTRUM  = 


’ IX) 


I F I LL1  (4864) 
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250  TT=TT+DT 

DO  300  1-1, L 
XX=XM  ( I ) *X  ( I ) 

M=XX 
M=M+5 1 
I P ( I ) =M 

I F (PP  (M)  .EQ.V  .OR.  PP(M).EQ.BL)  GO  TO  270 
PP  (M)  = AST 
GO  TO  300 
270  PP  (M)  = SM  (I ) 

300  CONTINUE 

I F (K.LT. 10)  GO  TO  320 
K=  1 

WRITE  (6,2000)  TT.PP.TT 
GO  TO  3^0 

320  WRITE  (6,2001)  PP 
K=K+1 
C 

C RESET  PP 
C 

3A0  DO  360  I = 1 , L 
M=  I P ( I ) 

360  PP  (M) =BL 
500  CONTINUE 
TT=TT+DT 
C 

WRITE  (6,2000)  TT,  (V, 1 = 1, 101)  ,TT 
WRITE  (6,1000) 

C 

RETURN 

C 

C FORMATS 
C 

999  FORMAT  (1H1.57X.15H0  R D I N A T E ) 

1000  FORMAT  ( / 1H  .3X.7HT  I M E , 2X , 4H- 1 . 0, 2 IX, 4H-0 .5, 22X , 3H0 .0 , 22X, 

1 3H0.5.22X.3H1 .0.LX.7HT  I M E,  IX) 

2000  FORMAT  (1H  , F 10. k,kX,  101 A 1 , F 1 2 .if) 

2001  FORMAT  (1H  , 14X.101A1) 

3000  FORMAT  (I8.12X,  I3.1P2EU.4.3X,  16) 

C 

END 

SUBROUTINE  SSLAW  (D , E ,TEMP, DCA , KAXES , KMAT.NEL, DUM, ALPHA) 

C 

C CALLED  BY  ? THDFE 

C 

C 

C THIS  ROUTINE  FORMS  THE  STRESS-STRAIN  LAW  IN  MATERIAL  COORDINATES 
C (X1.X2.X3)  AND  TRANSFORMS  THE  MATERIAL  SYSTEM  LAW  TO  GLOBAL 
C COORDINATES  (X.Y.Z) . 

C 

DIMENSION  D (6,6)  , E (12)  ,TEMP(6,6)  , DCA  (3,3)  , I PRM  (3)  , DUM  (6 ,6)  , 

1 ALPHA  (6) 


C 


DATA  I PRM  / 2,3,1  / 
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C FORM  THE  DIRECT  STRAIN  PARTITION  OF  THE  STRAIN-STRESS  LAW  IN 
C MATERIAL  COORDINATES  (X1.X2.X3) 

C 

DO  20  1-1,3 
ALPHA  ( I ) = E (1+9) 

ALPHA  ( I +3)  * 0.0 

IF  (E  (I)  .GT.l .0E-08)  GO  TO  15 

WRITE  (6,3000)  I.I.KMAT.NEL 

3000  FORMAT  (23HOERROR***  MODULUS  E(,2M,16H)  FOR  MATERIAL  ( , I 3 » 
1 litH)  IN  ELEMENT  (J5.10H)  IS  ZERO.,  / IX) 

15  TEMP  (1,1)  = 1 .0/E  (I) 

20  CONTINUE 


TEMP  (1,2)  = “E  (4)  * TEMP  (2,2) 

TEMP  (2,1)  = TEMP  (1,2) 

TEMP  (1,3)  = -E(5)*  TEMP  (3, 3) 

TEMP  (3,1)  = TEMP  (1,3) 

TEMP  (2 , 3)  = -E  (6)  * TEMP(3,3) 

TEMP  (3,2)  = TEMP  (2,3) 

C 

C INVERT  THE  DIRECT  STRAIN  PARTITION 

C 

DO  60  N=  1 , 3 
X = 1 .O/TEMP  (N,N) 

DO  30  J=1 , 3 

30  TEMP  (N , J)  = - TEMP  (N , J)  * X 
C 

DO  50  1=1,3 
I F (N.EQ.  I)  GO  TO  50 
DO  40  J-1,3 
IF  (N.EQ. J)  GO  TO  40 

TEMPO, J)  = TEMPO,  J)  + TEMPO, N)  *TEMP(N,J) 
40  CONTINUE 

50  TEMPO, N)  = TEMPO  ,N)  * X 
C 

TEMP  (N  , N)  = X 
60  CONTINUE 


C FORM  THE  COMPLETE  STRESS-STRAIN  LAW  IN  MATERIAL  COORDINATES 

C 

DO  70  1=1,6 
DO  70  J=1 ,6 
70  D (I  , J)  = 0.0 
C 

DO  80  1=1,3 
DO  80  J=1 ,3 
80  D(l  ,J)  = TEMPO  ,J) 

C 

D (4,4)  «E(7) 

D (5,5)  = E(9) 

D (6 , 6)  * E (8) 

C TRANSFORM  THE  MATERIAL  LAW  TO  GLOBAL  COORDINATES  (X,Y,Z) 

C 
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IF  (KAXES.LT. 1)  RETURN 
C 

C TRANSFORMATION  BETWEEN  MATERIAL  STRAINS  AND  GLOBAL  STRAINS 


C 

C 

C 


DO  100  11*1,3 
12  = I PRM  (II) 

DO  90  J1  * 1,3 
J2  = IPRM(Jl) 
TEMP  (II  , J 1 ) 

TEMP  ( I 1+3 , J 1 ) 

TEMP  ( I 1 , J 1+3) 

TEMP ( I 1+3.J1+3) 

1 

90  CONTINUE 
100  CONTINUE 


DCA  (J  1 , I 1)  *DCA  (J  1 , I 1) 

DCA  (J  1 , I 1 ) *DCA  (J  1 , I 2)  * 2.0 
DCA  (J  1 , I 1)  *DCA  (J2,  I 1) 

DCA  (J1 , I 1)  *DCA  (J2,  12)  + 

DCA  ( J 2 , I 1)  *DCA  (J  1 , 12) 


ROTATE  THE  MATERIAL  LAW  TO  THE  GLOBAL  SYSTEM 


DO  130  1=1,6 
DO  120  J=1 ,6 
X = 0.0 
DO  1 10  K=1 ,6 

1 10  X = X + D (I  ,K)  *TEMP  (K,  J) 
120  DUM  ( I ,J)  = X 
130  CONTINUE 
C 


DO  160  1=1,6 
DO  150  J=l ,6 
X = 0.0 
DO  140  K=1 ,6 

140  X = X + TEMP  (K , I ) *DUM  (K , J) 

D ( I , J)  = X 
D (J  , I ) = X 
150  CONTINUE 
160  CONTINUE 
C 

C TRANSFORM  THE  EXPANSION  COEFFICIENTS  FROM  MATERIAL  COORDINATES 
C TO  GLOBAL  COORDINATES 
C 
C 

DO  200  1=1,6 
X = 0.0 
DO  190  K* 1,3 

190  X = X + TEMP  (K, I) *E  (K+9) 

I F (I  . GT. 3)  X *X*2 .0 
200  ALPHA  (I ) - X 


RETURN 

END 

SUBROUTINE  SSPCEB  (NEQ.MBAND , NBLOCK, NEQB, NF , NV.NWA, NWV, NWVV, NTB, 
1 I FPR, I FSS.NITEM.RTOL, ANORM.COFQ) 

REAL  TIM1 .TIM2.TIM3 
C 

C CALLS?  INVECT, DECOMP, REDBAK , E I GSOL , SCHECK 

C CALLED  BY?  MODES 
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COMMON  /TAPES/NST IF.NRED.NL, NR, NT, NMASS 
COMMON  /EM/  AT(IOOO)  , IFILL  (3138) 

COMMON  /one/  A(l) 

c 

C ESTABLISH  STARTING  TRANSFORMATION  VECTORS  ON  TAPE  NR 
C 

N2=1+NWV 

N3=N2+NEQB 

C***  CALL  TT I ME  (T I Ml ) 

CALL  I NVECT  (A  (1 ) , A (N2)  , A (N 3)  > NBLOCK , NEQB, NV,  I FPR) 

C***  CALL  TT I ME  (T I M2) 

C 

C FACTORIZE  STIFFNESS  MATRIX 
N2=1+NWA 
N3-N2+NWA 

CALL  DECOMP+  (AO)  , A (N2)  , A (N3)  . NEQB , MBAND , NBLOCK , NWA , NTB , NSCH , NEQ, 
1 Ml) 

C***  CALL  TT  I ME  (T I M3) 

C 

C CHECK  FOR  ZERO  E I GENVALUE  (S) 

NN=NEQ  - ( (NBLOCK-1)  *NEQB) 

IF  (A  (NN)  .GT.ANORM)  GO  TO  10 
WRITE  (6,1120) 

STOP 

C 

10  T I Ml  =T  I M2-T I Ml 
T I M2=T  I M3-T I M2 
IF  (IFPR.EQ.l) 

* WRITE  (6, 1010)  T I Ml 
IF  (IFPR.EQ.l) 

A WRITE  (6, 1000)  T I M2 
C 

C PERFORM  SUBSPACE  ITERN 
DO  100  1=1, NV 
100  A ( I ) =0 .0 
N I TE=0 

200  N I TE=N ITE+1 

V/R1TE  (6,1020)  NITE 
C***  CALL  TT I ME  (T I Ml) 

N 1=1+2*NV 
N2-N1+NWA 
N3-N2+NWV 

CALL  REDBAK  (A  (Nl) ,A  (N2)  , A (N3) > A (N4) , NEQB, NV, NWA, NWV.NWVV, NTB, 

1 NBLOCK, Ml .MBAND) 

C 

c SOLVE  SUBSPACE  EIGENVALUE  PROBLEM 
N2=1+NV 
N3-N2+NV 
N4=N3+NV*NV 

N5=n4+nv*nv 

N6=N5+NV*NV 

N7=N6+NWV 
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N8=N7+NWV 

N9=N8+NV 

CAA*  CALL  TTIME  (TIM2) 

CALL  EIGSOL  (A  (1)  ,A(N2)  ,A(N3)  ,A(N4)  ,A(N5)  ,A(N6)  ,A(N7)  ,A(N8)  ,A(N9) 
1 ,NF ,NV,NBLOCK,NEQB,N ITE , I FPR , N I TEM, RTOL , I FSS.COFQ) 

C**A  CALL  TTIME (T I M3) 

TIM1-TIM3-TIM1 
T I M2=T I M3-T I M2 
IF  ( I FPR. EQ. 1) 

* WRITE  (6,1030)  T I Ml 
IF  (IFPR.EQ.l) 

A WRITE  (6, 1040)  T I M2 
C 

IF  (NITE.LT.NITEM)  GO  TO  200 
C 

WRITE  (6,1050) 

WRITE  (6,1060)  (A (I)  ,1=1, NF) 

P 1 2=8 .ODO*ATAN  (1 .ODO) 

DO  340  1-1, NF 
AT ( I +NF)  =A ( I +NV) 

340  AT  ( I ) =P 1 2/SQRT  (A  ( I ) ) 

C 

IF  (IFSS.EQ.l)  GO  TO  600 
C 

C APPLY  STURM  SEQUENCE  CHECK 
C*A*  CALL  TTIME (T I Ml) 

N2-1+NV 

N 3*N2+NV 

N4-N3+NWA 

N5=N4+NEQB 

N6-N5+NV 

N7=N6+NV 

N8-N7+NV 

CALL  SCHECK  (A  ( 1 ) ,A(N2)  ,A(N3)  ,A(N4)  ,A(N5)  ,A(N6)  ,A(N7)  ,A(N8)  ,NWA, 
1NEQB,NBL0CK,NF,NV, SHIFT, NEI , IF PR, RTOL) 

WRITE  (6,1085)  SHIFT 
N2-1+NWA 
N3-N2+NWA 

CALL  DECOMP  (A  (1) ,A  (N2)  ,A  (N3) , NEQB ,MBAND .NBLOCK , NWA , NTB , NSCH , NEQ, 

1 Ml) 

IF  (NSCH. EQ. NEI)  GO  TO  500 
NSCH-NSCH-NE I 
WRITE  (6,1090)  NSCH 
GO  TO  540 

500  WRITE  (6,1100)  NSCH 

CA**  540  CALL  TTIME  (TIM2)  1540  IS  TRANSFERED  TO  THE  NEXT  LINE 
540  T I M2-T I M2-T I Ml 

WRITE  (6,1110)  T I M2 
C 

600  RETURN 
C 

1000  FORMAT  (34H0TIME  FOR  STIFFNESS  FACTORIZATION  F6.2) 

1010  FORMAT  (42H0TIME  FOR  GENERATION  OF  INITIAL  TR-VECTORS  F6.2) 

1020  FORMAT  (////  3 1H  ITERATION  NUMBER  (ASSPCEBA)  - |4  ////  IX) 

1030  FORMAT  (24HOTIME  USED  IN  ITERN  STEP  F6.2) 
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lOLO  FORMAT  (25HOTIME  FOR  EIGENVALUE  SOLN  F6.2) 

1050  FORMAT  (///  LOH  WE  SOLVED  FOR  THE  FOLLOWING  EIGENVALUES  ) 

1060  FORMAT  (1H0.6E22.1L) 

1085  FORMAT  (1H1 , 22HCHECK  APPLIED  AT  SHIFT  E22.lL) 

1090  FORMAT  (10H0THERE  ARE  IL.21H  EIGENVALUES  MISSING  ) 

1100  FORMAT  (20H0WE  FOUND  THE  LOWEST  IL.12H  EIGENVALUES  ) 

1110  FORMAT  (30H0TIME  FOR  STURM  SEQUENCE  CHECK  F6.2) 

1120  FORMAT  (38HO***ERROR  SOLUTION  STOP  IN  *SSPCEB*  / 12X, 

1 25HRIGID  BODY  MODE  (S)  FOUND.,  / IX) 

C 

END 

SUBROUTINE  STEP 
REAL  T.PT.DUM 
C 

C CALLS?  ADDMAS, PLOAD.EMIDS. GROUND, INDLY, I NTH  I S , LOADV, INOUT, 

C TRIFAC.SOLSTP.SDSPLY 

C CALLED  BY?  MAIN 
C 

C CONTROL  ROUTINE  FOR  THE  STEP-BY-STEP  INTEGRATION  OF  THE 
C EQUATIONS  OF  MOTION.  THE  TIME  DIFFERENCE  FORMULA  USED  IS 

C THE  *W  I LSON  THETA  ALGORITHM*  WHICH  IS  UNCONDITIONALLY 

C STABLE  FOR  ANY  CHOICE  OF  TIME  STEP. 

C 

COMMON  /ELPAR/  NPAR(lL) .NUMNP.MBAND.NELTYP.Nl ,N2,N3,NL,N5,MT0T,NEQ 
COMMON  /JUNK/  KK1.KK2, ISP1, ISP2,NSD,NSS,NBL, LAST , DUM  (6L)  , 

1 NUA(IOO)  , IFILL1  (258) 

COMMON  /DYN/  NT, NOT, ALFA, DT , BETA, NFN.NGM, NAT , I F I LL2 

COMMON  /EXTRA/  MODEX,NT8,N10SV,NT10,KEQB,NUMEL,T (10) 

COMMON  /SOL/  NBLOCK.NEQB, I F I LL3  (9) 

C 

DIMENSION  PT(7)  , I A ( 1 ) 

EQUIVALENCE  (A  ( 1 ) , I A ( 1 ) ) 

COMMON  /one/  A(l) 

C 

C ASSEMBLE  THE  SYSTEM  MASS  MATRIX  (DIAGONAL).  THE  MASS  MATRIX 
C DIAGONAL  IS  STORED  IN  CORE  AS  A VECTOR.  SAVE  THE  SYSTEM 

C MASS  VECTOR  ON  TAPE3- 

C 

PT  (1)  » T(9) 

N2*N 1+6*NUMNP 

N3=N2+NEQ 

NL-N3+NEQB 

IF  (NL.GT.MTOT)  CALL  ERROR  (NL-MTOT) 

C 

IF  (MODEX.EQ.O) 

*CALL  ADDMAS  (A  (N2)  ,A(N3)  , NEQ, NEQB , NBLOCK) 

C 

c DYNAMIC  LOADS 
C 

IF  (NFN.GE.l)  GO  TO  25 
WRITE  (6,3010) 

STOP 

25  N3«N2+NFN*NEQ 
NL=N3+NFN*NEQ 

I F (NL.GT.MTOT)  CALL  ERROR (NL-MTOT) 
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C 

CALL  PLOAD  (A  (N  1 ) , A (N2)  , A (N 3)  , NUMNP , NEQ, NFN) 
IF  (NGM.EQ.O)  GO  TO  100 
C 

C ADD  GROUND  MOTION  EFFECTS 
C 

IF  (MODEX.EQ.O) 

*CALL  EMIDS  (A  (N 1 ) , A (N2) , NUMNP , NEQ) 

C 

N2«N1+NEQ*NFN 

N3*N2+NEQ*NFN 

N4-N3+NEQ 

N5=N4+NEQ 

I F (N5.GT.MT0T)  CALL  ERROR  (N5-MT0T) 

C 

CALL  GROUND  (A  (Nl)  , A (N2)  ,A  (N3)  , A (N4)  , NEQ, NFN) 
C 

C READ  TIME  DELAYS 
C 


100  N2  = Nl  + NEQ*NFN 
N3  = N2  + NEQ*NFN 
N4  = N3+  NAT 

I F (Nl+.GT.MTOT)  CALL  ERROR  (Nl*-MT0T) 

C 

CALL  INDLY  (A  (Nl)  , A (N2)  , A (N3) ,NEQ,NFN,NAT,MAXD) 
C 


C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 


N2=N 1+NFN 
KN=2*NFN 

READ  TIME  FUNCTIONS  DESCRIBING  LOAD  HISTORIES 
CALL  I NTH  I S (A  (N  1 ) , A (N2)  , NFN  , MXLP , KN) 

ALLOCATE  STORAGE  FOR  LOAD  VECTOR  CALCULATIONS 
KN  = 2*NFN 

NFN  = NUMBER  OF  TIME  FUNCTIONS 

MXLP  = MAXIMUM  NUMBER  OF  POINTS  DESCRIBING  ANY  FUNCTION 

NEQ  * NUMBER  OF  RETAINED  GLOBAL  DEGREES  OF  FREEDOM 


N3=N2+KN*MXLP 

N4-N3+NEQ 

N5-Nif+NFN*NEQ 

N6«N5+NFN*NEQ 

N7-N6+NEQ 

IF (N7.GT.MT0T)  CALL  ERROR  (N7-MT0T) 

C 

I F (MODEX.EQ. 1)  GO  TO  120 
C 

C COMPUTE  THE  SYSTEM  LOAD  VECTORS  AT  EACH  SOLUTION  TIME  STEP 
C AND  SAVE  ON  TAPE2 . 

C 

CALL  LOADV  (A  (N 1)  , A (N2)  , A (N3)  . A (N4)  , A (N5)  , A (N6)  ,NEQ,  NFN , KN) 
C 

C***  120  CALL  TTIME  (PT  (2) ) 1120  IS  TRANSFERED  TO  THE  NEXT  LINE 
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120  N2=N1+NEQ 
C 

C READ  OUTPUT  REQUESTS 

CALL  INOUT  (A  (N 1)  , A (N2)  , A (N2)  , NUMNP) 

C 

C***  CALL  TT I ME (PT (3) ) 

C RESTORE  MASS  MATRIX  TO  CORE  THEREBY  RELEASING  TAPE3  FOR  SCRATCH 
C 

N2  = Nl+NSD 
N3  = N2+NSS 
NL  = N3+NEQ 
C 

I F (MODEX.EQ. 1)  GO  TO  130 
REWIND  3 
MM  = NL-1 

READ  (3)  (A  (K)  ,K=N3.MM) 

130  CONTINUE 

Kl  = NEQB*  (2*MBAND+1 ) +MBAND+NL 

K2  = 4*NEQ+NSD+NSS+NEQB*  (MBAND+1) +MBAND+N4 

K = k 1 

IF  (K2.GT.K1)  K = K2 
IF  (K.GT.MTOT) 

*CALL  ERROR  (K-MTOT) 

C 

NTB  = (MBAND-2) /NEQB  +1 
IF  (NTB.GE.NBLOCK)  NTB  = NBLOCK  -1 
C 

C PRINT  EQUATION  SIZE  PARAMETERS 

WRITE  (6,2003)  NEQ.MBAND, NEQB, NBLOCK, NTB 

C DECOMPOSE  STIFFNESS  MATRIX 

C 

Ml  = NEQB+MBANO-1 
NWA  = NEQB*MBAND 
N5  = NL+NWA 
N6  = N5+NWA 
N7  = N6+M I 

I F (N7.GT.MT0T)  CALL  ERROR  (N7“MT0T) 

C 

I F (MODEX.EQ. 1)  GO  TO  170 

C CALL  TRIFAC  (A  (M)  , A (N5)  .A  (N6)  , NEQB, MBAND. NBLOCK, NWA, NTB, NEQ, Ml) 

c***  170  CALL  TT I ME  (PT  (4) ) 1170  IS  TRANSFERED  TO  THE  NEXT  LINE 

C SET  UP  STORAGE  FOR  THE  TIME  MARCHING  SOLUTION 
C 

170  N5  = NM-NEQ 
N6  = N5+NEQ 
N7  * N6+NEQ 
N8  - N7+NEQ 
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C 

c 

c 

c 


c 

c 

c 

c 


c 

c 

c 

c 


c 

c*** 

180 

c 

c 

c 

c 

c 

c 

c. 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


N9  = N8+NWA 
N 1 0=  N9+MI 

1.  CHECK  THE  AMOUNT  OF  REMAINING  STORAGE  TO  SEE  IF  MORE  THAN 
ONE  ROW  CAN  BE  ALLOCATED  TO  THE  ARRAYS  *SDIS*  AND  *SSTR*. 

MM  - MT0T-N10 
NN  = NSD+NSS 

IF(NN.GT.MM)  CALL  ERROR  (NN-MM) 

MM  * MM/NN 

2.  COMPUTE  THE  NUMBER  OF  TIMES  AT  WHICH  OUTPUT  IS  TO  BE 
PRODUCED 

NPT  = NT/NOT 
I F (MM.GT.NPT)  MM-NPT 
N1 1=  N10+MM*NSD 

I F (MODEX.EQ. 1)  GO  TO  180 

SOLVE  EQUATIONS  OF  MOTION 

CALL  SOLSTP  (I  A (Nl)  , I A (N2)  , A (N3)  , A (N4)  , A (N5)  , A (N6)  , A (N7)  , A (N8)  , 

5 A (N9)  ,A  (N10)  ,A (Nil)  , NSD , NSS , NEQ, NEQB , MBAND , NWA , M I , 

2 MM.NBLOCK) 

180  CALL  TTIME  (PT  (5) ) ! 180  IS  TRANSFERED  TO  THE  NEXT  LINE 
REWIND  9 

I F (MODEX.EQ. 1)  GO  TO  350 

CONVERT  TIME  INTERVAL  TO  OUTPUT  TIME  INTERVAL 
DT=DF  LOAT  (NOT) *DT 

PASS  IF  PRINT  INTERVAL  EXCEEDS  THE  NUMBER  OF  SOLUTION  STEPS. 

I F (NPT.LT. 1)  GO  TO  350 

COMPUTE  THE  NUMBER  OF  DISPLACEMENT  RECORDS  SAVED  PREVIOUSLY  DURING 
THE  TIME  MARCHING  PHASE.  EACH  RECORD  HAS  *MM*OUTPUT  VECTORS. 

NBL  - (NPT- 1) /MM  +1 

ALLOCATE  STORAGE  FOR  DISPLACEMENT  COMPONENT  OUTPUT 
I F (NSD . LT. 1)  GO  TO  350 

1.  NUMBER  OF  OUTPUT  SETS  AT  EIGHT  (8)  COMPONENTS  PER  SET 
NUM  = (NSD-D/8  +1 

2.  COMPUTE  THE  NUMBER  OF  OUTPUT  DISPLACEMENT  VECTORS  (AT  *NSD* 
ELEMENTS  PER  VECTOR)  WHICH  WILL  FIT  IN  REMAINING  CORE. 

PASS  IF  ALL  VECTORS  CURRENTLY  FIT  IN  CORE. 
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C 

IF  (NBL.EQ. 1)  GO  TO  270 
N2  = N1+MM*NSD 
MREM  = MT0T-N2 
MMX  = MREM/NSD 
C 

c 3.  COMPUTE  THE  LARGEST  NUMBER  OF  OUTPUT  VECTORS  (EVENLY  DIVIS- 

C | BLE  BY  *MM*)  WHICH  CAN  BE  RETAINED  IN  REMAINING  CORE.  IF 

C THIS  NUMBER  IS  AT  LEAST  TWICE  THE  EXISTING  NUMBER  PER  RECORD 

C (*MM*) , THEN  ALLOW  COMPACTION  BEFORE  OUTPUT  — OTHERWISE 

C PASS. 

C 

MMX  = MMX/MM 
MMX  = MMX*MM 
K = NBL*MM 
I F (MMX.GT.K)  MMX  = K 
NK  = 2*MM 

IF  (MMX . GE .NK)  GO  TO  300 
C 

C I*.  NO  TAPE  COMPACTIONS. 

C 

270  CONTINUE 
N2  = N 1 
MMX=  MM 
C 

C OUTPUT  SELECTED  DISPLACEMENTS 

0 

300  CALL  SDSPLY  (A  (N1)  , A (N2)  ,MMX,MM,NSD,NUM, 1 ,KK1 ,2, ISP1 ,NPT,4) 

C 

C*ft*  350  CALL  TTIME  (PT  (6) ) 1350  IS  TRANSFERED  TO  THE  NEXT  LINE 

C 

350  I F (MODEX.EQ. 1)  GO  TO  450 
C 

C ALLOCATE  STORAGE  FOR  ELEMENT  STRESS  COMPONENTS  OUTPUT 
C 

IF  (NPT.LT.1)  GO  TO  450 
IF  (NSS.LT.l)  GO  TO  450 
IF  (NBL.EQ. 1)  GO  TO  370 
C 

N2  = N 1+MM*NSS 
MREM  = MT0T-N2 
MMX  = MREM/NSS 
MMX  - MMX/MM 
MMX  - MMX*MM 
K - NBL*MM 
IF  (MMX.GT.K)  MMX  - K 
NK  - 2*MM 

IF  (MMX.GT.NK)  GO  TO  400 
C 

370  CONTINUE 
N2  = N 1 
MMX*  MM 
C 

C OUTPUT  SELECTED  STRESSES 
C 
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400  CALL  SDSPLY  (A  (N 1 ) , A (N2) , MMX , MM, NSS ,NUA, NELTYP , KK2 , 1 , I SP2 , NPT , 7) 

C 

C**ft  1*50  CALL  TTIME  (PT  (7) ) ! 450  IS  TRANSFERED  TO  THE  NEXT  LINE 
C 

C COMPUTE  TIME  LOG 

C 

450  DUM(l)  - 0.0 
DO  500  1-1,6 
PT  (I)  - PT  (1  + 1)  -PT  ( I ) 

500  DUM(l)  = OUM  ( 1 ) +PT  ( I ) 

PT(7)  = DUM(l) 

WRITE  (6,2001)  PT 
C 

C FORMATS 

C 

2001  FORMAT  (41H1T  I M E LOG  (PARTICULAR  SOLUTION),  // 

1 5X.29HF0RM  DYNAMIC  LOADS  =,F9.2  / 

2 5X.29HPR0CESS  OUTPUT  REQUESTS  -,F9.2  / 

4 5X.29HMATRIX  DECOMPOSITION  =,F9.2  / 

5 5X.29HSTEP-BY-STEP  INTEGRATION  =, F9- 2 / 

6 5X , 2 9HD I S PLACEMENT  OUTPUT  =,F9.2  / 

7 5X.29HELEMENT  STRESS  OUTPUT  -,F9.2  // 

8 5X.29HT0TAL  STEP-BY-STEP  ANALYSIS  =,F9.2  ////  IX) 

2003  FORMAT  (38HIE  QUATION  PARAMETERS,// 

1 5X.33HT0TAL  NUMBER  OF  EQUATIONS  -,  15  / 

2 5X.33H1/2  EQUATION  BANDWIDTH  =,  15  / 

3 5X.33HNUMBER  OF  EQUATIONS  PER  BLOCK  =,  15  / 

4 5X.33HTOTAL  NUMBER  OF  EQUATION  BLOCKS  =,  15  / 

5 5X.33HNUMBER  OF  COUPLING  BLOCKS  =,  15  //  IX) 

3010  FORMAT  (42H0***  ERROR  NO  DYNAMIC  FUNCTIONS  (INPUTS),  / IX) 

C 

RETURN 

END 

SUBROUTINE  STRESR  (SF , F I , SRM.NF , NSB , NEQB, NBLOCK) 

C 

C CALLS?  ELOUTR 

C CALLED  BY?  RESPEC 

C 

C COMPUTE  AND  PRINT  RMS  STRESSES 

C 

DIMENSION  SF  ( 1 2 , NF) , F I (NSB , NF) ,SRM(12) 

COMMON  /EM/  SA(42,63)  ,ND,NS,LM(63)  , IS  (13) 

COMMON  /ELPAR/  NPAR  (14) , NUMNP, MB AND, NELTYP, N1 ,N2,N3,N4,N5,MT0T,NEQ 
COMMON  /EXTRA/  M0DEX.NT8, I F I LL2  (14) 

C 

DATA  HI/1HI/.HC/1HC/.HJ/1HJ/ 

C 

C ASSEMBLE  MODESHAPES  IN  CORE 

C 

IF (MODEX.EQ.l)  RETURN 
REWIND  2 
READ  (2) 

NE-NSB 

NS-NE+1 -NEQB 
DO  100  1-1, NBLOCK 
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READ  (2)  ((FI  (J , K)  , J=NS , NE)  , K=  1 ,NF) 

NS=NS-NEQB 
100  NE=NE-NEQB 
110  CONTINUE 

c 

WRITE  (6,2000) 

REWIND  1 

DO  500  N= 1 .NELTYP 
READ  (1)  NPAR 
NUME=NPAR  (2) 

C 

C CONSIDER  EACH  ELEMENT  OF  THIS  TYPE  (NPAR  (1 ) ) 

C 

DO  400  M=1 , NUME 

READ  (1)  ND.NS,  (LM  (I ) , 1 = 1 ,ND)  , ( (SA  (I , J) , 1 = 1 ,NS) , J*1 ,ND) 

C 

NSET  = (NS— 1 ) / 1 2 +1 
DO  390  K3=1,NSET 
K 1 = (K3-l)*12  +1 
K2  = K 1+1 1 
I F (K2 .GT.NS)  K2=NS 
L = 0 

DO  132  K*K 1 ,K2 
L = L+l 
132  I S (L)  * K 
I S (L+l ) = 0 
L=0 
C 

C COMPUTE  MODAL  STRESSES 
C 

DO  300  1=1,12 

IF (IS (I) . EQ.O)  GO  TO  350 

I I = IS (I) 

L = L+l 
DO  200  K* 1 , NF 
SS  = 0.0 
DO  150  J=1 , ND 
JJ  = LM  (J) 

IF  (JJ.LE.O)  GO  TO  150 

SS  = SS  + SA  (I  I , J)  * FI  (JJ,K) 

150  CONTINUE 
200  SF  (L , K)  = SS 
300  CONTINUE 
C 

350  DO  220  1=1 , L 
SRM  (I ) *0 . 

DO  220  K=1 , NF 

220  SRM  ( I ) =SRM  ( I ) +SF (I ,K) *SF (I ,K) 

DO  210  1=1 , L 
210  SRM ( I ) *SQRT (SRM ( I ) ) 

C 

CALL  ELOUTR  (NEL , I S , L , NPAR  (1)  , NS) 

C 

WRITE  (6,2030)  (SRM(I)  ,1  = 1, L) 
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WRITE  (6,2035) 

C 

C IF  REQUESTED,  PUNCH  PIPE  ELEMENT  (NPAR(l) .EQ. 12)  MEMBER  END  FORCES 
C AND  MOMENTS  AT  POINTS  ( I , J)  FOR  A TANGENT  AND  (C,J)  FOR  A BEND 

C A VALUE  OF  ONE  (1)  FOR  NPAR  ( 1 3)  ACTIVATES  THE  PUNCH  OPTION 

C NPAR  (14)  IS  A 5 DIGIT  IDENTIFIER  PUNCHED  IN  CC  76-80  OF  ALL  CARDS 
C 

IF  (NPAR  (1) .NE. 12)  GO  TO  333 
IF  (NPAR  (13)  .NE. 1)  GO  TO  333 
IF  (NS.EQ. 18)  GO  TO  328 

WRITE  (11,5000)  M,  (SRM(I)  , 1 = 1 , 6)  , HI  , NPAR  (13)  ,NPAR  (14) 

WRITE  (11,5000)  M,  (SRM(I)  , 1=7,  12)  ,HJ,NPAR(13)  ,NPAR(1L) 

GO  TO  333 
328  IF  (K3 . EQ . 1) 

*WRITE  (11,5000)  M,  (SRM(I)  ,1-7,12)  ,HC,MPAR(13)  ,NPAR(li») 

IF  (K3.EQ.2) 

*WR  I TE  (11,5000)  M,  (SRM(I)  , 1 = 1 , 6)  ,HJ,NPAR  ( 1 3)  ,NPAR  (14) 

333  CONTINUE 
C 

390  CONTINUE 
400  CONTINUE 
C 

500  CONTINUE 
C 

2000  FORMAT  (1H1.47HR  ESPONSE  SPECTRUM  STRESS, 

1 3X.19HC  0 M P 0 N E N T S,  //  23H  SQUARE  ROOT  OF  THE  SUM, 

2 37H  OF  THE  SQUARES  OF  THE  MODAL  STRESSES,  / 

3 19H  (FOR  ALL  ELEMENTS),  ///  IX) 

2030  FORMAT  (12E1 1 .4) 

2035  FORMAT  (1H0) 

C 

5000  FORMAT  (3X, I3,4X,6E10.3,A1, I2.2X, 15) 

C 

RETURN 

END 

SUBROUTINE  STRETR  (NNS.RHOM) 

C 

C CALLS?  QDCOS ,TDCOS .TRFPRD , CSTSTR, LCT9ST 
C CALLED  BY?  TPLATE 

C 

C THIS  ROUTINE  FORMS  THE  ELEMENTS  MASS  MATRIX  AND  THE 
C STRESS  (MOMENT)  - DISPLACEMENT  TRANSFORMATION  MATRIX 
C EVALUATED  AT  THE  ELEMENT  CENTROID 

C THE  GLOBAL  FORCES  DUE  TO  A UNIT  VALUE  OF  APPLIED  NORMAL  PRESSURE 

C ARE  ALSO  CALCULATED 

C 

COMMON  /QTSARG/ 

1 XX  (5)  , YY  (5)  ,ZZ(5)  ,HM(5)  ,HP(5)  ,CM(3,3)  , ALFA  (3)  ,HW(5)  ,RH0(5,3)  . 

2 p(5)  ,T(5)  ,DT(5)  ,SM(5,3)  , BM  (5 , 3)  , TD I S (36)  .TROT  (36)  ,S(30,30)  , 

3 R (30) 

COMMON  /TRIARG/ 

1 A (3)  , B (3)  ,H(3)  , HPT  (3)  , C (3,3)  ,SMT(3,3)  , BMT  (3,3)  » FT  (12)  , 

2 PX  (3)  ,PY(3)  ,PT(3)  , RM  (3)  , ST  (1  2 , 1 2) 

COMMON  /EM/ 

1 LM  (24) ,ND,NS,STRAN(6,30) , NC (3)  , I PAD, AREA, XMM.TDl (13)  , TD2 ( 1 3)  , 
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C 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 

c 


2 TD3(9)  ,TR1  (9)  .TR2(9)  ,TR3(9)  .SCST(3,6)  .XST(3,6)  .5LCT9(3.9)  . 

3 XLCT9(3,9)  .DUMMY  (238)  ,RF  (24,4)  ,XM(24)  . SA  (12,24)  ,SF  (12,4)  ,PF  (24)  , 

4 IF  ILL  (3000) 

COMMON  /TRANSF/ 

1 T1  (3)  »T2  (3)  ,T3  (3)  .TO  (3, 3) 

DIMENSION  I PERMQ  (4) 

DATA  IPERMQ/2,3,1*.  V 

NEN  = MINO(NNS,4) 

WG  = 1.0 

I F (NEN.EQ.4)  WG  = 0.25 

N3  = 2*NEN  - 3 

NC  (3)  = N3 

NTR I = 3*NEN  - 8 

COMPUTE  DIRECTION  COSINE  ARRAY  FOR  THE  ELEMENT  AXES 
CALL  QDCOS  (NTRI ,XX,YY ,ZZ,TO) 

CLEAR  THE  MASS  MATRIX  VECTOR,  STRESS  TRANSFORMATION  ARRAY  AND  THE 
GLOBAL  FORCE  VECTOR  DUE  TO  A UNIT  NORMAL  PRESSURE 

DO  10  K= 1 , ND 
XM  (K)  = 0.0 
PF (K)  =0.0 
DO  5 1=1, NS 

5 STRAN  (I  , K)  =0.0 
10  CONTINUE 

IF  (NTRI .EQ. 1)  GO  TO  20 
DO  15  1=25,30 
DO  15  J=1,NS 
15  STRAN  (J, I)  =0.0 
20  CONTINUE 

LOOP  OVER  NTRI  TRIANGLE  SUB-ELEMENTS  ASSEMBLING  STRESS/ 
DISPLACEMENT  TRANSFORMATION  AND  MASS  MATRICES 

DO  300  NT*1 .NTRI 
N1  = NT 

N2  = I PERMQ  (Nl) 

NC  (1)  = Nl 
NC  (2)  = N2 

COMPUTE  DIRECTION  COSINES  OF  LOCAL  TRIANGLE  SYSTEM  AND  THE 
TRIANGLE  PROJECTIONS  (A,B)  ONTO  THE  LOCAL  X.Y  PLANE 

CALL  TDCOS  (N 1 , N2 ,N3, XX , YY , ZZ, A, B) 

COMPUTE  MASS  COEFFICIENTS  FOR  THE  SUB-ELEMENT  (TRIANGLE)  AND 
ASSEMBLE  INTO  THE  MASS  ARRAY.  ALSO,  COMPUTE  NODAL  FORCES 
DUE  TO  UNIT  VALUE  OF  NORMAL  PRESSURE. 

AREA  = (A(3)*B(2)  - A (2)  *B  (3) ) * 0.5 
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XMM  = (HW  (N 1)  +HW  (N2)  +HW  (N 3) ) * AREA*  RHOM/  9.0 
FAC  = AREA/  3.0 
C 

DO  40  1=1,2 
K = 6*  (NC  (I)  -1) 

DO  30  L=1 , 3 
K = K+l 

PF  (K)  = PF  (K)  + FAC*  T3(L) 

30  XM  (K)  = XM  (K)  + XMM 
40  CONTINUE 

DUM  = XMM*  0.5 
0U2  = FAC*  0.5 
I F (NTR I .EQ. 1)  GO  TO  45 
K 1 = 6*  (N  1 - 1 ) 

K2  = 6*  (N2- 1 ) 

GO  TO  50 
45  K 1 = 6*  (N 3- 1 ) 

K2  = K 1 

50  DO  60  L=1 ,3 
K 1 = K 1+1 
K2  = K2+1 

PF  (Kl)  = PF  (Kl)  + DU2*  T3  (L) 

XM(K1)  = XM(K1)  + DUM 
PF  (K2)  = PF  (K2)  + DU2*  T3  (L) 

60  XM  (K2)  = XM  (K2)  + DUM 
C 

C FORM  TRANSFORMATIONS  BETWEEN  SUB-ELEMENT  (TRIANGLE)  LOCAL 
C SYSTEM  AND  THE  GLOBAL  COORDINATE  SYSTEM 

C 

CALL  TRFPRD  (0, NEN ,TD I S ,TD I S ,TD I S ,TD 1 ,TD2 ,TD3) 

CALL  TRFPRD  (0 , NEN .TROT, TROT, TROT, TR 1 ,TR2 ,TR3) 

C 

C MEMBRANE  CONTRIBUTION 

C 

CALL  CSTSTR  (SCST.XST) 

C 

Kl  = 0 

DO  100  JJ=1 , 3 
M = 6*(NC(JJ)-1) 

DO  100  L— 1,3 
M = M+l 
Kl  = K 1+1 
DO  80  K2-1.3 

STRAN  (K2 , M)  = STRAN  (K2 , M)  +(SCST(K2,JJ  ) * TD 1 (K 1 ) 

1 + SCST  (K2 , JJ+3)  * TD2  (Kl) ) * WG 

80  CONTINUE 
100  CONTINUE 
C 

C BENDING  CONTRIBUTION 
C 

DO  1 10  K=1 ,3 
N = NC  (K) 

110  HPT  (K)  = HP  (N) 

C 

CALL  LCT9ST  (SLCT9. 3 , XLCT9) 
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C 


DO  200  JJ=1 ,3 
I = 3*  (JJ-1) 

M = 6*(NC(JJ)-1) 

DO  1 80  L-1,6 
M = M+l 

IF  (L.GT.3)  GO  TO  120 
K 1 = l+L 
DO  115  K2-1 ,3 

115  STRAN  (K2+3.M)  * STRAN  (K2+3.M)  + 
GO  TO  1 80 
120  K 1 = l+L-3 
DO  130  K2=l  ,3 

STRAN (K2+3 i M)  * STRAN (K2+3.M)  + 
1 + 
130  CONTINUE 
180  CONTINUE 
200  CONTINUE 


SLCT9  (K2 , J J) * TD3  (K 1 ) * WG 


(SLCT9  (K2 , JJ+3)  * TR1  (Kl) 

SLCT9  (K2 , J J+6) * TR2 (K 1 ) ) * WG 


300  CONTINUE 

PERFORM  CONDENSATION  ON  INTERNAL  DEGREES  OF  FREEDOM  FOR 
QUADRILATERAL  ELEMENTS  STRESS/DISPLACEMENT  TRANSFORMATION 

IF  (NTR I .EQ. 1)  GO  TO  500 

DO  400  N= 1 ,6 
K = 30-N 
L = K+l 
PIV  = S (L,L) 

IF  (PIV.LT. 1 .OE-8)  GO  TO  400 
DO  390  Kl-1,6 
DUM  = STRAN  (K1,L) 

STRAN  (Kl.L)  - STRAN  (K1,L)/  PIV 
DO  380  1=1 ,K 

STRAN  (K  1,1)  = STRAN  (K 1 , I ) - S(I,L)*  DUM 
380  CONTINUE 
390  CONTINUE 
400  CONTINUE 


C 

500  DO  510  K 1 = 1 ,NS 
DO  510  K2=l , ND 
SA  (K 1 , K2)  = STRAN  (K1.K2) 

510  CONTINUE 
C 

RETURN 

SUBROUTINE  STRSD1  (NUM, SF , F I , X, NF , NSB ,NDS ,NEQB,NBLOCK) 


C 

C 

C 

C 


CALLS?  DISPLY 
CALLED  BY?  HISTRY 


) I MENS  I ON  NUM (1 ) ,SF  (8,NF)  ,FI  (NSB.NF)  ,X(NF,NDS) 

COMMON  /EM/  ND,NS,LM(100)  ,SA(1)  , IFILL2(5034) 

COMMON  /ELPAR/  NPAR  ( 1 4) ,NUMNP,MBAND,NELTYP ,N1 ,N2,N3.N4,N5*MT0T,NEQ 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


COMMON  /JUNK/  N.NEL, I S (1 3)  ,M. I , L, KS  (3.8) , I I ,K.SS, J . JJ 
.NUME.NE, IFILL1 (380) 

COMMON  /EXTRA/  MODEX , NT8 , I F I LL3  (1 4) 

C 

C ASSEMBLE  MODE  SHAPES  IN  CORE 
C 

IF  (MODEX. EQ. 1)  GO  TO  1 10 
REWIND  7 
READ  (7) 

NE=NSB 

NS=NE+1 -NEQB 
DO  100  I *1 , NBLOCK 

READ  (7)  ((FI  (J,K)  , J=NS,NE)  , K=1  ,NF) 

NS=NS-NEQB 
100  NE=NE-NEQB 
C 

C FORM  STRESS  MATR I X , MODE  SHAPE  TRANSFORMATION  FOR 
C SELECTED  STRESS  COMPONENTS  ONLY. 

C 

REWIND  1 
REWIND  3 
C 

1 10  CONTINUE 

READ  (5,1000)  KKK , ISP 
WRITE  (6,3000) 

IF  (MODEX. EQ.l)  GO  TO  600 
DO  500  N= 1 , NELTYP 
READ  (1)  NPAR 
WRITE  (3)  NPAR 
WRITE  (6,3001)  NPAR ( 1 ) 

READ  (5,1000)  NEL.IS 

WRITE  (6,2000)  NEL,  (IS  (I)  , 1 = 1 , 12) 

NUME=NPAR  (2) 

L=0 

NUM  (N)  =0 
C 

DO  LOO  M= 1 , NUME 
IF  (NEL.EQ.M)  GO  TO  LlO 
READ  (1) 

GO  TO  LOO 

LlO  READ  (1)  NO, NS 
BACKSPACE  1 
NOT  = NS*  ND 

READ  (1)  ND.NS,  (LM  (I)  , 1 = 1 ,ND) , (SA  (K) ,K=1 ,NDT) 

C 

DO  300  1=1, NS 
I l-IS  (I) 

I F (I  I . EQ.O)  GO  TO  350 
L-L+l 

KS  (1 ,L) =NEL 
KS  (2 , L)  =1  I 
C 

DO  200  K= 1 , NF 
SS=0 . 

KK  = I I 
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DO  150  J-l.ND 
JJ  = LM  (J) 

IF(JJ)  150,150,140 
140  SS=SS+SA(KK)*FI  (JJ.K) 

150  KK=KK+NS 
200  SF  (L , K) =SS 

IF  (L.LT.8)  GO  TO  300 
WRITE  (3)  L.KS.SF.NS 
L=0 

NUM  (N)  =NUM  (N)  + 1 
300  CONTINUE 

350  READ  (5,1000)  NEL, IS 

WRITE  (6,2000)  NEL , ( I S ( I ) ,1  = 1,12) 

1*00  CONTINUE 

IF  (L.EQ.O)  GO  TO  500 
WRITE  (3)  L.KS.SF.NS 
NUM  (N)  =NUM  (N)  + 1 
500  CONTINUE 

WRITE  (6,4000)  KKK.ISP 

COMPUTE  AND  OUTPUT  HISTORY  OF  VALUES 

CALL  DISPLY  (X , SF , NF , NDS , NUM, NELTYP , KKK , 1 , I SP) 

RETURN 

READ  OUTPUT  REQUESTS  FOR  THE  DIFFERENT  ELEMENTS 


600  L = 0 
610  L=L  + 1 

(010  FORMAT  (6(///136HL0UTPUT  REQUESTS  FOR  ELEMENT  GROUP  = J3,// 

1 8H  ELEMENT , 5* , 25HDES I RED  STRESS  COMPONENTS  ) 

630  READ  (5, 1000)  NEL, IS 

IF  (NEL.LT.l)  GO  TO  620 

WRITE  (6,2000)  NEL,  (I S (I)  , 1=1 , 12) 

GO  TO  630 

620  IF  (L.LT. NELTYP)  GO  TO  610 
WRITE  (6,4000)  KKK.ISP 
RETURN 


C 

1000  FORMAT  (1415) 

2000  FORMAT (4X, I4.3X, 121 3) 

3000  FORMAT  (25H1ELEMENT  STRESS  COMPONENT, 

1 22H  TIME  HISTORY  REQUESTS, 

3001  FORMAT  (22H  ELEMENT  TYPE  NUMBER  =,  13 

1 11HS  T R E S S.6X.17HC  0 M P 0 N E N 

2 12 (3H  *)  / IX) 

4000  FORMAT  (//  25H  CODE  FOR  OUTPUT  TYPE 

1 3X.19HEQ.1,  HISTORY  TABLE, 

2 3X, 18HEQ.2,  PRINTER  PLOT, 

3 3X.17HEQ.3,  MAXIMA  ONLY, 

4 25H  PRINTER  PLOT  SPACING 


/ 

//  IX) 

//  8H  ELEMENT, 5X, 

T,/  8H  NUMBER, 3X, 

= , 12  / 

/ 

/ 

/ 

-,  12  / IX) 
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C 

END 

SUBROUTINE  ST8R21  (E , B , S , XX , NOD9 , H , P, S I GOT, DELT, FT, DL , XM, NEL , ND , 

1 I ELD, IELX,KTL,KGL, KMS , N I NT, N I NTZ, WTDEN , MSDEN) 

C 

C CALLED  BY  ? THDFE 

C CALLS  ? DER3DS 

C 
C 
C 

C 

c . 
c . 

C . HEXAHEDRAL  CURVILINEAR  THREE-DIMENSIONAL  ELEMENTS 

C . 

C . ISOPARAMETRIC  OR  SUBPARAMETR I C 

C . 

C . 

C 

c 

c 

c 

DIMENSION  E (6, 1)  ,B  (6,  1)  ,S  (63,  1)  ,XX  (3,  1)  ,NOD9(l)  ,H  (1)  , P (3,  1)  , 

1 S I GDT  (1)  , DELT  (1)  , FT  (1)  , DL  (1)  ,XM  (1)  , D (9)  , SDT  (6)  , BV  (63)  , 

2 W (3,3)  , I PERM  (3,3)  . KDX  (3)  , LDX  (3) 

C 

COMMON  /GAUSS/  XG  (4,4)  ,WGT  (4,4) 

C REAL  MSDEN 
REAL  MSDEN 
C 

DATA  IPERM  / 1,4,6,  4,2,5,  6,5,3  / 

C 

VOL  - 0.0 
C 

C DETERMINE  IF  THE  MATERIAL  IS  ORTHOTROPIC  (ISO.EQ.l,  ISOTROPIC) 

C 

DUM  - 0.0 
DO  20  1-4,6 
J - 1-1 
DO  20  K= 1 , J 

20  DUM  - DUM  +ABS  (E  (K, I)) 

ISO  - 1 

IF(DUM.GT.1.0E-6)  ISO  - 0 
I F (I SO.EQ.O)  GO  TO  24 
DO  22  1-2,3 

DUM  - DUM  +ABS  (E  ( I ,1  ) -E  (1-1 . 1-1)) 

22  DUM  - DUM  +ABS  (E  (1+3, 1+3)  -E (1+2, 1+2)) 

DUM  - DUM  +ABS  (E  (1  ,2  ) - E (2  ,3  )) 

DUM  - DUM  +ABS  (E  (2  ,3  ) - E (3  ,1  )) 

IF  ( DUM.GT. 1 .OE-6  ) ISO-O 
24  CONTINUE 
C 

c 
c 
c 


VOLUME  INTEGRATION  LOOP 
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C 

DO  10  LX-1 , N I NT 
DO  10  LY-1 , N I NT 
E 1 =XG  (LX , N I NT) 

E2=XG  (LY.NINT) 

DO  10  LZ-l.NINTZ 
E3=XG  (LZ.NINTZ) 

C 

WT=WGT  (LX , N I NT) *WGT  (LY.NINT) *WGT  (LZ , N I NTZ) 

C 

C EVALUATE  STRAIN-DISPLACEMENT  MATRIX  B AND  JACOBIAN  DETERMINANT 
C 

CALL  DER3DS  (NEL , XX , B , DET, E 1 , E2 , E3 , N0D9 ,H , P, I ELD, I ELX) 

C 

C ADD  CONTRIBUTION  TO  ELEMENT  STIFFNESS 
C 

FACT  = WT * DET 
FACT2  =SQRT  (FACT) 

C 

DO  25  1 = 1,1  ELD 
K3  = 3*1 
K2  = K3-1 
K 1 = K2  — 1 

BV(K1)  = B (1  ,K1)  * FACT2 
BV  (K2)  = B (2.K2) * FACT2 
BV(K3)  = B(3,K3)*  F ACT2 
25  CONTINUE 
C 

DO  30  1=1 . ND 
DO  30  J=l , ND 

30  S(l  ,J)  = S(l  ,J)  + BV(I)*  BV  (J) 

C 

C ACCUMULATE  ELEMENT  VOLUME 

C 

VOL  = VOL  + FACT 
C 

C COMPUTE  GRAVITY  LOADS 

C 

IF  (KGL.EQ.O)  GO  TO  150 
DO  130  K=1 , I ELD 

130  DL  (K)  = DL  (K)  + H (K) *FACT*  WTDEN 
C 

C ' COMPUTE  THERMAL  LOADING  NODE  FORCE  VECTOR 
C 

150  I F (KTL.EQ.O)  GO  TO  1 90 
C 

C 1.  ELEMENT  TEMPERATURE  DIFFERENCE  AT  THIS  INTEGRATION  POINT 

C (R.S.T) 

C 

DT  = 0.0 
DO  160  K=1 , I ELD 
160  DT  « DT  + H (K)*  DELT(K) 

DT  *=  DT*  FACT 
C 

C 2.  INITIAL  STRESSES  AT  (R.S.T) 
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DO  170  K=1 ,6 

170  SDT(K)  = SIGDT(K)  *DT 
C 

C 3.  NODE  FORCES 

C 

DO  180  K= 1 , ND 
DO  175  1=1.6 

175  FT(K)  = FT  (K)  + B ( I , K)  * SDT(I) 

180  CONTINUE 
C 

190  CONTINUE 
10  CONTINUE 
C 

DO  35  1=1.2 
1C  = ND- I 
DO  35  J= 1 , I C 

M=J+ 1 

35  S(M,J)  = S (J  ,M) 

C 

C COMPLETE  THE  K-MATRIX  WITH  APPROPRIATE  MATERIAL  CONSTANT  MULT- 
C PLICATIONS  OF  THE  INTEGRATED  B(I)*B(J)  ARRAY. 

C 

C 1 . TEST  FOR  MATERIAL  TYPE 

C 

IF (ISO.EQ.O)  GO  TO  75 
C 

C A.  ISOTROPIC  MATERIAL 

C 

D1  = E ( 1 , 1) 

D2  = E(l, 2) 

D3  = E (4,4) 

C 

DO  60  1 = 1,1  ELD 
K3  = 3*1 
K2  = K3-1 
K 1 = K2- 1 
KO  = K 1 - 1 
DO  60  J=l , I ELD 
L3  - 3*J 
L2  = L3-1 
LI  = L2-1 
LO  * L 1 - 1 
C 

1C  = 0 
DO  401 1=1,3 
M = I 1+  KO 
DO  40  JJ=1 ,3 
N = JJ+  LO 
1C  = IC+  1 
D ( I C)  = S(M,N) 

40  CONTINUE 
C 

S (K 1 , L 1 ) = D(l)*  D1  + (D  (5)  + D (9) ) * 03 
S(K2,L2)  = D (5)  * D1  + (D  (1)  + D (9) ) * D3 
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S (K 3 * L3)  = D(9)* 
S (K 1 ,L2)  = D (2)  * 
S (K2 . L 1 ) = D(4)* 
S(K2,L3)  = D(6)* 
S(K3,L2)  = D(8)* 
S(K3,L1)  = D (7)  * 
S (K 1 » L 3)  = D(3)* 
C 

60  CONTINUE 


01  + (0(5)  + D(l))*  D3 
D2  + 0(4)*  D3 

02  + D (2)  * D3 
D2  + D (8)  * D3 
D2  + D (6)  * D3 
D2  + D (3)  * D3 
D2  + D (7)  * D3 


C 


GO  TO  1 10 


C B.  ANISOTROPIC  MATERIAL 

C 

75  DO  100  1 = 1 , I ELD 
KO  = 3*1-3 
DO  100  J=l , I ELD 
LO  = 3*J"3 
C 

DO  8o  11=1,3 

M = I l+KO 

DO  80  JJ=1 ,3 

N = JJ+LO 

W(l  I ,JJ)  = S (M, N) 

80  CONTINUE 
C 

DO  100  K= 1 , 3 
I I = KO+K 
DO  82  I J= 1 , 3 

82  KDX  ( I J) = I PERM  ( I J , K) 

DO  95  L=1 ,3 

12  = LO+L 

DO  83  IJ-1.3 

83  LDX  ( I J) = I PERM ( I J , L) 

C 

SUM=0 . 0 


DO  90  11=1,3 
K 1 = KDX  (I  I) 

DO  85  J J= 1 ,3 
K2  = LDX(JJ) 

C 

85  SUM  = SUM  + W ( I I , J J) *E  (K 1 , K2) 
90  CONTINUE 
C 

S (I  1 , I 2)  = SUM 
C 

95  CONTINUE 
100  CONTINUE 
110  CONTINUE 
C 
C 

C REFLECT  FOR  SYMMETRY 
C 


DO  200  1=1, ND 
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DO  200  J= I , ND 
200  S (J,  I)  = S (I  , J) 

C 

C CONSTRUCT  THE  LUMPED  MASS  MATRIX 
C 

I F (KMS.EQ.O)  RETURN 
C 


FACT  = VOL*  MSDEN/  I ELD 
DO  220  K-l.ND 
220  XM(K)  = FACT 
C 
C 


C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 


RETURN 

END 

SUBROUTINE  TANGDC  (NEL, XI ,X2, ACARD, A, MODEX, XLN) 

CALLED  BY?  PIPEK 

COMPUTATION  OF  DIRECTION  COSINE  ARRAY  FOR  THE  LOCAL  AXES  OF  PIPE 
TANGENT  ELEMENT 


NEL 

= 

ELEMENT  NUMBER 

XI 

= 

GLOBAL  COORDINATES  OF  END  1 

X2 

= 

GLOBAL  COORDINATES  OF  END  J 

ACARD 

3 

GLOBAL  PROJECTIONS  OF  THE  LOCAL  Y-AXIS  AS  INPUT 
ON  THE  ELEMENT  CARD 

A 

MATRIX  OF  DIRECTION  COSINES  RELATING  LOCAL  TO  Tl 
GLOBAL  SYSTEM.  A ( 1 , J)  IS  THE  PROJECTION  ON  THE 
l-TH  GLOBAL  AXIS  OF  A UNIT  VECTOR  IN  THE  LOCAL 
J — D 1 RECTI  ON . 

MODEX 

EXECUTION  MODE 
(EQ.O,  SOLUTION) 
(EQ.l,  DATA  CHECK) 

XLN 

= 

TANGENT  ELEMENT  LENGTH 

DIMENSION  XI  (3)  ,X2(3)  .ACARD  (3)  .A  (3.3) 

common  /say/  neqq , numee, 1 oopur , nnbl ock , nterms.opt i on 

common  /what/  naxa  (10000) , i rowl  ( 10000) , i col h (10000) 

LOCAL  X-AXIS  FROM  NODE  I TO  NODE  J 

A (1 , 1)  * X2  (1)  -XI  (1) 

A (2,1)  - X2  (2)  -XI  (2) 

A (3,1)  « X2  (3)  -X 1 (3) 

XLN  - A (1 , 1)  **2  + A(2,l)**2  + A(3,l)**2 
XLN  *SQRT  (XLN) 

IF  (XLN .GT. 1 .OE-8)  GO  TO  20 
WRITE  (6,3000)  NEL 
MODEX  - 1 
RETURN 

20  DUM  - 1 .O/XLN 
DO  25  K-1,3 

25  A (K,  1)  = A (K,  1)  * DUM 


C 

C 


LOCAL  Y-AXIS 
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C 

c 1.  TEST  FOR  USER  INPUT  FROM  THE  ELEMENT  CARD 

C 

DUM  = ACARD  (1)**2  + ACARD  (2)  **2  + ACARD  (3)  **2 
IF  (DUM.LT.  1 .OE-8)  GO  TO  1*0 
C 

c 2.  DIRECT  USER  INPUT  OF  THE  LOCAL  Y-AXIS 

C 

DUM  = 1 .O/SQRT  (DUM) 

DO  30  K= 1 , 3 

30  A(K,2)  = ACARD  (K)  * DUM 
C 

c 3.  TEST  FOR  ZERO  PROJECTION  OF  THE  INPUT  Y-AXIS  ON  THE  KNOWN 

C LOCAL  X-AXIS  DIRECTION 

C 

DUM  = A (1  , 1)  *A  (1  ,2)  + A (2, 1)  *A  (2,2)  + A (3, 1 ) *A  (3, 2) 

DUM  =ABS  (DUM) 

C 

I F (DUM.LT. 1 .OE-6)  GO  TO  60 
WRITE  (6,3010)  NEL 
C 

c L.  COMPUTE  THE  ORIENTATION  OF  THE  Y-AXIS  USING  THE  DEFAULT 

C CONVENTION 

C 

1*0  DU2  = A (1  , 1)  **2  + A (3,  1)  **2 


C 5-  TEST  FOR  FOR  THE  CASE  OF  THE  MEMBER  LONGITUDINAL  AXIS 

C BEING  PARALLEL  TO  THE  GLOBAL  Y-AXIS 

C 

IF  (DU2.GT.1 .OE-12)  GO  TO  50 
C 

C 6.  VERTICAL  MEMBER 

C 

A (1 , 2)  =0.0 
A (2,2)  =0.0 
A (3 , 2)  = 1.0 
GO  TO  60 
C 

c 7.  NON-VERTICAL  MEMBER 

C 

50  DU2  =SQRT  (DU2) 

A (1 , 2)  = -A(1,1)*A(2,1)/DU2 
A (2,2)  * DU2 

A (3 . 2)  = "A  (3,  1)  *A  (2, 1)  /DU2 
C 

C LOCAL  Z-AXIS 

C 

60  CONTINUE 

A (1 , 3)  * A (2, 1)  *A  (3, 2)  - A(3,1)*A(2,2) 

A (2 , 3)  * A (3»  1)  *A  (1 , 2)  - A (1 , 1)  *A  (3. 2) 

A (3, 3)  = A (1 , 1)  *A  (2,2)  - A (2,  1)  *A  (1  ,2) 

C 

RETURN 


C 

3000  FORMAT  (36HOERROR*** 


ZERO  LENGTH  FOR  ELEMENT  (,IU,  2H) 


/ IX) 
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C 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


3010  FORMAT  (51HOERROR***  USER  DEFINED  Y-AXIS  IS  NOT  PERPENDICULAR, 

1 46H  TO  THE  LONGITUDINAL  AXIS  OF  TANGENT  ELEMENT  (,I4,2H).,  / 

2 1 1 X , 27HDE FAULT  CONVENTION  ASSUMED.,  / IX) 

END 

CALLS?  PINVER 
CALLED  BY?  PIPEK 

COMPUTATION  OF  THE  ELEMENT  STIFFNESS  AND  LOAD  MATRICES  FOR  A 
TANGENT  (STRAIGHT)  PIPE  ELEMENT. 


ALFAV 

= 

SHAPE  FACTOR  FOR  SHEAR  DISTORTION 
(GT. 99-99,  NEGLECT) 

E 

* 

YOUNG*S  MODULUS 

XNU 

= 

POISSON*S  RATIO 

AREA 

m 

SECTION  AREA 

XM  1 

3C 

MOMENT  OF  INERTIA 

NODE 

= 

NODE  NUMBER  AT  END  J OF  THE  TANGENT 

NEL 

s 

PIPE  ELEMENT  NUMBER 

MODEX 

= 

EXECUTION  MODE 
(EQ.l,  DATA  CHECK) 

F (6,6) 

s 

FLEXIBILITY  MATRIX  AT  NODE  J 

XLN 

= 

LENGTH  OF  THE  TANGENT 

THERM 

= 

THERMAL  EXPANSION  COEFFICIENT 

P 

■ 

INTERNAL  PIPE  PRESSURE 

WALL 

= 

PIPE  WALL  THICKNESS 

DOUT 

* 

OUTSIDE  DIAMETER  OF  THE  PIPE 

B 

■ 

FREE  END  DEFLECTIONS  AT  NODE  J DUE  TO 

(1)  UNIFORM  LOAD  IN  THE  X DIRECTION 

(2)  UNIFORM  LOAD  IN  THE  Y DIRECTION 

(3)  UNIFORM  LOAD  IN  THE  Z DIRECTION 

(4)  UNIFORM  THERMAL  EXPANSION  (DT=1) 

(5)  P.  INTERNAL  PRESSURE 

H = FORCE  TRANSFORMATION  RELATING  REACTIONS  AT  NODE  I 

DUE  TO  UNIT  LOADS  AT  NODE  J 

S = LOCAL  TANGENT  ELEMENT  STIFFNESS  MATRIX 

FEF  = FIXED  END  FORCES  (ACTING  ON  THE  NODES)  DUE  TO 

(1)  UNIFORM  LOAD  IN  THE  X DIRECTION 

(2)  UNIFORM  LOAD  IN  THE  Y DIRECTION 

(3)  UNIFORM  LOAD  IN  THE  Z DIRECTION 

(4)  UNIFORM  THERMAL  EXPANSION  (DT-1) 

(5)  P,  INTERNAL  PRESSURE 

XM  = LUMPED  MASS  MATRIX 

SA  - STRESS-DISPLACEMENT  TRANSFORMATION  RELATING  THE 

12  GLOBAL  COMPONENTS  OF  DISPLACEMENT  TO  THE  6 
LOCAL  COMPONENTS  OF  MEMBER  LOADS  LOCATED  AT  NODE 
I AND  AT  NODE  J. 

FEFC  = FIXED-END  FORCE  CORRECTIONS  TO  THE  MEMBER  LOADS 

DUE  TO  THE  FIVE  (5)  TYPES  OF  ELEMENT  LOADS 
XMAS  - MASS  PER  UNIT  LENGTH  OF  THE  SECTION 

OC  * ARRAY  OF  DIRECTION  COSINES  WHICH  TRANSFORMS  LOCAL 

VECTORS  TO  GLOBAL  VECTORS 
SUBROUTINE  TANGKS 
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C 

C 

C 

c 

c 

c 


c 

c 

c 


c 

c 

c 


c 

c 

c 

c 

c 

c 

c 

c 


c 

c 

c 

c 

c 

c 


c 

c 

c 


COMMON  /PI  PEC/  ALFAV,E,XNU,DU1 ,DU2, I DUM3, NODE , NEL , MODEX , 

1 XLN , THERM, P, AREA , XM I , WALL , DOUT, XMAS 

COMMON  /EM/  I XX  (1 4)  , S (12,  12)  , RF  (12,4)  , XM  (1 2)  • SA  (1 8 , 1 2)  , 

1 SF  (18,4)  ,FEF  (12,5)  ,FEFC(l8,5)  ,F  (6,6)  ,B(6,6)  , 

2 H (6,6)  , DC  (3,3)  ,IFILL2  (3606) 

COMMON  /ELPAR/  NPAR  ( 1 4)  , I F I LL  1 ( 1 0) 

common  /say/  neqq,numee, 1 oopur , nnb 1 ock , nterms , option 
common  /what/  naxa  (10000) , i rowl  (10000) , i col h (10000) 

SET  THE  FACTOR  FOR  AXIAL  DEFORMATIONS 

AXIAL  = 1 .0 

SET  THE  FACTOR  FOR  SHEAR  DEFORMATIONS  (EQ.O,  NEGLECT) 

XKAP  = ALFAV 

I F (ALFAV.GT. 99-99)  XKAP  = 0.0 

COMPUTE  THE  MATERIAL  FACTORS 

RE  = 1.0/E 
XNU 1 = 1.0+XNU 

COMPUTE  SECTION  PROPERTY  CONSTANTS 

RA  = AX  I AL*XLN*RE/AREA 

RV  = 2 .0*XKAP*XNU1*XLN*RE/AREA 

RT  = XNU1*XLN*RE/XMI 

RB  = XLN*RE/XMI 

XL2  = XLN**2 

FORM  THE  NODE  FLEXIBILITY  MATRIX  AT  NODE  J REFERENCED  TO  THE 
LOCAL  (X , Y , Z)  COORDINATE  SYSTEM  AT  NODE  I. 

X - DIRECTION...  AXIAL  FROM  NODE  I TO  NODE  J 
Y - DIRECTION...  TRANSVERSE  BENDING  AXIS 

Z - DIRECTION...  TRANSVERSE  BENDING  AXIS  ORTHOGONAL  TO  X AND  Y 

DO  50  1=1,6 
DO  50  K= I ,6 
F (I  ,K)  =0.0 
50  CONTINUE 

AXIAL 

F (1,1)  = F (1,1)  + RA 
SHEAR 

F (2,2)  = F (2,2)  + RV 
F (3,3)  - F (3,3)  + RV 

TORSION 

F (4,4)  = F (4,4)  + RT 
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C 

C BENDING 
C 

F (2,2)  = F (2,2)  + RB*XL2/3-0 

F (3.3)  - F (3.3)  + RB*XL2/3.0 

F (5,5)  - F (5.5)  + RB 

F (6,6)  = F (6,6)  + RB 

F (2,6)  = F (2,6)  + RB*XLN*0.5 

F (3,5)  = F (3,5)  " RB*XLN*0.5 

C 

DO  60  1*1,6 
DO  60  K= I ,6 
F (K,  I)  = F (I  , K) 

60  CONTINUE 

C****  PRINT  THE  NODE  FLEXIBILITY  MATRIX 
I F (NPAR  (9)  . LT. 1)  GO  TO  6690 
WRITE  (6,4000) 

WRITE  (6,4010)  ((F  (I ,K) ,K=1,6) , 1 = 1 ,6) 

6690  CONTINUE 

c 

C FORM  THE  NODE  STIFFNESS  MATRIX 
C 

CALL  PINVER  (F , 6 , 6 , NODE , NEL , MODEX) 

C****  PRINT  THE  NODE  STIFFNESS  MATRIX 
IF  (NPAR  (9)  .LT.  1)  GO  TO  669 1 
WRITE  (6,4020) 

WRITE  (6,4030)  ((F  (I  ,K)  ,K=1 ,6)  , 1=1  ,6) 

6691  CONTINUE 

C**** 

c 

C COMPUTE  THE  OEFLECT I ONS/ROTAT I ONS  (MEASURED  IN  THE  X,Y,Z  SYSTEM 
C AT  NODE  I)  AT  NODE  J DUE  TO  UNIFORM  LOADS  IN  EACH  OF  THE  X,Y,Z 

C DIRECTIONS  (AT  I).  THE  UNIFORM  LOADS  ARE  DIRECTION  INVARIANT 

C WITH  POSITION  ALONG  THE  LENGTH,  AND  NODE  I IS  COMPLETELY  FIXED 
C WHILE  NODE  J IS  FREE. 

C 

DO  70  1=1 ,6 
DO  70  K= 1,3 
B ( I , K)  = 0.0 
70  CONTINUE 
C 

C AXIAL 

C 

RA  * 0.5*RA*XLN 
B (1 , 1 ) = B (1  , 1)  + RA 
C 

C SHEAR 

C 

RV  = 0.5*RV*XLN 
B (2 , 2)  = B(2,2)  + RV 
B (3. 3)  - B (3,3)  + RV 
C 

C BENDING 

C 
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RB  = RB*XL2/6 .0 
B (2.2)  = B (2.2)  + RB*XLN*0.75 
B (3 . 3)  = B (3. 3)  + RB*XLN*0.75 
B (5.3)  - B (5. 3)  - RB 
B (6,2)  = B (6, 2)  + RB 

C COMPUTE  THE  FREE  NODE  DEFLECTIONS  AT  END  J DUE  TO  A UNIFORM 
C THERMAL  EXPANSION 
C 

DO  80  1=1,6 
B (I  ,4)  = 0.0 
80  CONTINUE 


C 

B (1 , 4)  = XLN*THERM 


C COMPUTE  THE  FREE  NODE  DEFLECTIONS  AT  ENO  J DUE  TO  PRESSURE 
C 

DO  90  1=1,6 
B ( I ,5)  = 0.0 
90  CONTINUE 
c 

C MEL  REPORT  10-66,  EQUATION  (3-28) - 
C 

RM  = (DOUT-WALL) *0.5 

B (1 , 5)  = 0.5*P*RM*RE/WALL* (1 .0-2.0*XNU) *XLN 

Cft***  PRINT  THE  FREE  END  DEFLECTIONS 
I F (NPAR  (9)  .LT. 1)  GO  TO  6692 
WRITE  (6,4050) 

WRITE  (6,4060)  ( (B  ( I . K) ,K-1 .5) .1-1,6) 

6692  CONTINUE 


C 

c 

c 

c 

c 


SET  UP  THE  FORCE  TRANSFORMATION  RELATING  REACTIONS  AT 
ACTING  ON  THE  MEMBER  END  DUE  TO  UNIT  LOADS  APPLIED  TO 
END  AT  NODE  J. 


NODE  I 
THE  MEMBER 


DO  100  1=1,6 
DO  100  K=1 ,6 
H (I  ,K)  = 0.0 
100  CONTINUE 


C 

DO  105  K-l ,6 
H (K , K)  —1.0 
105  CONTINUE 
C 

H (6,2)  = -XLN 
H (5, 3)  « XLN 

C FORM  THE  UPPER  TRIANGULAR  PORTION  OF  THE  LOCAL  ELEMENT  STIFFNESS 
C MATRIX  FOR  THE  TANGENT 
C 

DO  1 10  K= 1 ,6 
DO  no  l=K,6 
S (K+6, 1+6)  = F (K , I ) 

110  CONTINUE 
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DO  130  IR-1,6 
DO  130  101,6 
S ( I R,  IC+6)  = 0.0 
DO  120  IN-1,6 

S (IR,  IC+6)  = S(IR,IC+6)  + H (I  R,  I N)  * F(IN.IC) 

120  CONTINUE 
130  CONTINUE 
C 

DO  150  IR-1,6 
DO  150  IC-IR.6 
S (IR, 1C)  = 0.0 
DO  140  IN-1,6 

S ( I R , 1C)  = S ( I R , I C)  + S (IR,  IN+6)  * H (I  C , I N) 

11*0  CONTINUE 
150  CONTINUE 
C 

C REFLECT  FOR  SYMMETRY 
C 

DO  160  1-1,12 
DO  160  K-l  , 12 
S (K,  I)  - S (I  ,K) 

160  CONTINUE 

C**A*  PRINT  THE  STIFFNESS  MATRIX  (LOCAL)  FOR  THE  TANGENT 
I F (NPAR  (9)  .LT.  1)  GO  TO  6693 
WRITE  (6,1*500) 

WRITE  (6,1*510)  ( (S  (I  ,J)  , J-l  ,6  ) , I -1 , 1 2) 

WRITE  (6,1*510)  ( (S  (I  ,J)  ,J-7, 12)  , 1-1,12) 

6693  CONTINUE 

C**rt* 

c 

C COMPUTE  THE  RESTRAINED  NODE  FORCES  ACTING  ON  THE  NODES  OF  THE 

C TANGENT  DUE  TO  THE  MEMBER  LOADINGS 

C 

DO  180  1-1,5 
DO  180  J-l , 12 
FEF  (J,  I)  = 0.0 
DO  170  K-l ,6 

FEF(J.I)  = FEF  ( J , I ) - S (J , K+6)  * B (K , I ) 

170  CONTINUE 
180  CONTINUE 
C 

C FOR  THE  DISTRIBUTED  LOADS  SUPERIMPOSE  THE  CANTILEVER  REACTIONS 
C ACTING  ON  THE  ELEMENT  AT  NODE  I. 

C 

DUM  - 0.5*XL2 
FEF  (1,1)  - FEF  (1,1)  - XLN 

C 

FEF  (2,2)  - FEF  (2,2)  - XLN 

FEF  (6,2)  - FEF  (6,2)  - DUM 

C 

FEF  (3.3)  - FEF  (3,3)  - XLN 

FEF  (5,3)  = FEF  (5,3)  + DUM 

C****  PRINT  THE  FIXED  END  QUANTITIES 
IF  (NPAR  (9)  . LT.  1)  GO  TO  669I. 
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WRITE  (6,4600) 

WRITE  (6,4610)  ((FEF  (I ,J) , J=1 ,5) . 1 = 1 . 12) 

6694  CONTINUE 
C**** 

c 

C FORM  THE  LUMPED  MASS  MATRIX 
C 

DUM  = 0.5*XLN*XMAS 
DO  200  K= 1 , 3 
XM  (K)  = DUM 

XM(K+6)  = DUM 
XM  (K+3)  =0.0 
XM  (K+9)  =0.0 
200  CONTINUE 
C 

C COMPUTE  THE  FIXED-NODE  CORRECTIONS  TO  THE  SECTION  STRESSES 
C DUE  TO  ELEMENT  LOADINGS.  FORCES  ACT  ON  THE  SEGMENT  BETWEEN 

C THE  POINT  OF  EVALUATION  AND  NODE  I. 

C 

C 1 . AT  NODE  I 

C 

DO  210  1=1,5 
DO  210  K=1 ,6 
F EFC  (K , I)  = -FEF  (K, I) 

C 

C 2.  AT  NODE  J 

C 

FEFC  (K+6, I ) = FEF  (K+6, I ) 

210  CONTINUE 

C****  PRINT  THE  FIXED-END  CORRECTIONS 
I F (NPAR  (9) . LT. 1)  GO  TO  6695 
WRITE  (6,4650) 

WRITE  (6,4660)  ((FEFC(I,J)  ,J=1, 5)  .1  = 1.12) 

6695  CONTINUE 

C**** 

C 

C FORM  THE  TRANSFORMATION  RELATING  GLOBAL  DISPLACEMENTS  AND  MEMBER 
C STRESS  RESULTANTS  AT  NODES  I AND  J. 

C 

DO  240  K 1 = 1 ,10,3 
FAC  = -1 .0 

IF  (K 1 .GT.4)  FAC  = 1 .0 

NRS  = Kl-1 

DO  240  K2=l ,10,3 

NCS  = K2-1 

DO  230  IR-1,3 

NR  = NRS+IR 

DO  230  I C=1 ,3 

NC  = NCS+IC 

SA(NR.NC)  = 0.0 

DO  220  IN-1 ,3 

N = NCS+IN 

SA  (NR , NC)  = SA  (NR , NC)  + FAC*  S(NR,N)*  DC(IC.IN) 

220  CONTINUE 
230  CONTINUE 
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240  CONTINUE 

C****  PRINT  THE  STRESS  DISPLACEMENT  TRANSFORMATION 
IF  (NPAR  (9)  . LT. 1)  GO  TO  6696 
WRITE  (6,4700) 

WRITE  (6,4710)  ( (SA  ( I , J)  ,J=1,  6) ,1  = 1,12) 

WRITE  (6,4710)  ( (SA  ( I , J) ,J=7, 12) ,1  = 1,12) 

6696  CONTINUE 


4000  FORMAT 
4010  FORMAT 
4020  FORMAT 
4030  FORMAT 
4050  FORMAT 
4060  FORMAT 
4500  FORMAT 
4510  FORMAT 
4600  FORMAT 
4610  FORMAT 
4650  FORMAT 
4660  FORMAT 
4700  FORMAT 
4710  FORMAT 
C 


(///  24H  NODE  FLEXIBILITY  MATRIX,  //  IX) 

( IX  / (6E20.8)  ) 

(///  22H  NODE  STIFFNESS  MATRIX,  //  IX) 

( IX  / (6E20.8)  ) 

(///  42H  FREE  NODE  DISPLACEMENTS  (5  MEMBER  LOADS),  //  IX) 
(IX  / (5E20.8)  ) 

(23H 1 LOCAL  STIFFNESS  MATRIX,  //  IX) 

(//  (/6E15.6)  ) 

(//  17H0FIXED  END  FORCES,  //  IX) 

(5E20.8) 

(//  43HOSTRESS  CORRECTIONS  DUE  TO  FIXED  END  FORCES,  //  IX) 
(5E20.8) 

(//35HOSTRESS-D I SPLACEMENT  TRANSFORMATION,  / IX) 

(///  (6E20.8)  ) 


RETURN 

END 

SUBROUTINE  TDCOS  (N 1 , N2 , N3, X , Y , Z, A , B) 

C 

C CALLED  BY?  STRETR.QTSHEL 
C 

C THIS  SUBROUTINE  COMPUTES  THE  DIRECTION  COSINES  OF  THE  LOCAL 

C SYSTEM  AND  THE  PROJECTED  DIMENSIONS  OF  A TRIANGLE  COMPONENT 

C 


COMMON  /TRANSF/  Tl  (3)  ,T2  (3)  ,T3  (3)  . T (9) 

EQUIVALENCE  (T11.T1  (1)) , (T12.T1  (2) ) , (T13.T1  (3) ) , (T2 1 , T2  ( 1 ) ) , 

1 (T22.T2  (2) ) , (T23,T2(3))  , (T31.T3  0))  , (T32,T3(2))  , (T33.T3  (3) ) 

DIMENSION  X (1)  , Y (1 ) , Z ( 1 ) , A(l)  , B (1) 

A 1 = X (N 1)  -X  (N3) 

B 1 - Y(N1)-Y(N3) 

Cl  = Z(N1)-Z(N3) 

A2  = X (N2)  -X  (N3) 

B2  - Y (N2)  -Y  (N3) 

C2  - Z(N2)-Z(N3) 

T31  - B1*C2-B2*C1 
T32  - C 1 *A2-C2*A 1 
T33  * A 1 *B2-A2*B 1 
S -SQRT  (T31**2+T32**2+T33**2) 

T3 1 * T31/S 
T32  * T32/S 
T33  - T33/S 

Tl  1 - T33*T  (5)  -T32*T  (8) 

T 1 2 - T31*T(8) -T33*T(2) 

T13  = T32*T(2)  -T31*T(5) 

S =SQRT  (Tl 1**2+T12**2+T13**2) 

Til  * Tl 1/S 
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C 

C 

C 

C 

C 

C 

c 

c 

c 


c 


c 


c 

c 


T 1 2 = T 1 2/S 

T1 3 - T 1 3/S 

T21  = T13*T32-T12*T33 

122  = T1 1*T33-T13*T31 

T23  = T12*T31-T11*T32 

A (1)  = -T1 1*A2-T12*B2-T13*C2 

A (2)  = T1 1*A1+T12*B1+T13*C1 

B (1)  = T2 1 *A2+T22*B2+T23*C2 

B (2)  = -T2 1 *A1 -T22*B1~T23*C1 

A (3)  = -A  (1) -A  (2) 

B (3)  = -B  (1)  -B  (2) 

RETURN 

END 

SUBROUTINE  THDFE  ( I D , X , Y , Z ,T , DEN , RHO , NTP , EE , 

1 DCA,NFACE,LT,PWA,LOC,MAXPTS,SS, 

2 NUME , NUMMAT , MAXTP , NORTHO , NDLS , MAXNOD , 

3 NOPSET, INTRS, INTT.NUMNP) 

CALLED  BY  ? SOL21 

CALLS  ? INP21 ,CALBAN,SSLAW,DER3DS,ST8R21 .FACEPR 


ROUTINE  FOR  THE  STIFFNESS,  MASS  AND  STRESS  MATRIX  GENERATION 
FOR  THE  8 -TO- 2 1 NODE  I SO- (OR  SUB)  -PARAMETR I C ORTHOTROPIC 
HEXAHEDRON. 

COMMON  /JUNK/  XLF  (4) , YLF  (4)  ,ZLF  (4) ,TLF  (4) ,PLF  (4) ,F ILL1  (22) ,V2  (3)  . 

1 F I LL2  (1  2)  , LS  (4)  ,KLS(4)  .NOD  (21)  ,NOD9M(13)  , KOD  (21)  , 

2 NREAD.TAG.E  (12) 

COMMON  /ELPAR/IFILL305)  .MBAND 

COMMON  /EM/  SDT  (42,63)  .SF  (42,4) , NS, ND,LM(63) 

DIMENSION  RF  (63.4)  ,XM(63)  ,D  (6,6)  ,TEMP  (6,6)  ,DUM(6,6)  , 

* ALPHA(6)  , XX  (3,21)  ,B  (6,63)  ,H  (21)  ,P(3,21)  ,SIGDT(6)  , 

* DELT  (2 1 ) , FT  (63)  ,DL  (21)  ,PL  (63)  ,LOCOP(7)  .VIS  (6) 

COMMON  /GAUSS/  XG  (4 , 4)  , WGT  (4 , 4) , STPTS  (27 , 3) 

COMMON  /DYN  / I F I LL4  (1 1)  ,NDYN 
COMMON  /EXTRA/  MODEX , NT8 

common  /say/  neqq.numee, loopur .nnblock.nterms, option 
common  /what/  naxa  ( 1 OOOO) , i rowl  (IOOOO) , i col h (10000) 

DIMENSION  ID  (NUMNP , 1)  , X ( 1 ) ,Y(1)  ,Z(1)  ,T(1)  , DEN  (1)  ,RHO  (1)  , 

1 NTP  ( 1 ) , EE  (MAXTP, 13, 1)  , DCA  (3, 3. D .NFACE  (1) , LT  (1 ) , 

2 PWA  (7,0  , LOC  (7,1)  ,MAXPTS(1)  , SS  (63.  D 


DATA  TGI , TG2  /'*' , 1 '/ 
STPTS (1,1)  =1. 

STPTS (2 , 1 ) =- 1 . 

STPTS  (3, 1)  — 1 • 

STPTS (4, 1) *1  . 

STPTS  (5,0=1  . 

STPTS  (6,1) — 1. 

STPTS  (7,0—1. 

STPTS  (8,  0=1  • 
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STPTS  (9, 1) =0. 
STPTS  (10, 1)— 1 . 
STPTS  (1 1 , 1) -0. 
STPTS  (1 2 , 1) =1 . 
STPTS  (13,  1)=0. 
STPTS  (14,  1)— 1. 
STPTS  (15, 1) =0. 
STPTS  (16, 1)-1. 
STPTS  (1 7 » 1 ) “1 • 
STPTS  ( 1 8 , 1 ) =- 1 . 
STPTS  (19, 1)  — 1 . 
STPTS  (20, 1) =1 . 
STPTS  (21  , 1)«0. 
STPTS  (22 , 1)  =1 . 
STPTS  (23.  1)— 1 . 
STPTS  (24. 1) -0. 
STPTS  (25, 1)«0. 
STPTS  (26,  l)-0. 
STPTS  (27.  l)-0. 
STPTS  (1  ,2)-l  . 
STPTS  (2 , 2)  = 1 . 
STPTS  (3,2)—  1. 
STPTS  (4,2)  — 1 . 
STPTS  (5.2) =1 . 
STPTS  (6,2) =1 . 
STPTS  (7,2)  — 1. 
STPTS  (8,2)  — 1. 
STPTS  (9.2)=1  . 
STPTS (10,2) =0. 
STPTS  (11, 2)— 1. 
STPTS (12,2) =0. 
STPTS (13,2)  =1 . 
STPTS  (14,2) -0. 
STPTS  (15,2)—  1. 
STPTS  (16,2) =0. 
STPTS  (1 7 , 2)  =1  . 
STPTS  (1 8, 2) =1 . 
STPTS  09,2)  —1 . 
STPTS  (20, 2)—  1. 
STPTS  (21 ,2) *0. 
STPTS  (22,2) -0. 
STPTS  (23, 2) *0. 
STPTS  (24',  2)  *1  . 
STPTS  (25,2)  — 1 
STPTS  (26,2) -0. 
STPTS  (27,2) -0. 
STPTS  ( 1,3)-1. 
STPTS  ( 2 , 3) “1 • 
STPTS  ( 3,3) -1  - 
STPTS  ( 4,3) -1. 
STPTS  ( 5,3)  — 1. 
STPTS  ( 6,3)  — 1. 
STPTS  ( 7,3)  — 1. 
STPTS  ( 8,3)  — 1 . 
STPTS  ( 9,3)=  1. 
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STPTS  (10,3)=  1 • 

STPTS  (11,3)=  1. 

STPTS  (12,3)=  1. 

STPTS  (13.3)— -1  • 

STPTS  (11*, 3)  — 1 • 

STPTS  (15.3) — 1 • 

STPTS  (16,3)  — 1 • 

STPTS  (17.3)  =0  * 

STPTS  (18,3) *0. 

STPTS  (19, 3)  =0. 

STPTS  (20,3)  =0. 

STPTS  (21 ,3) =0. 

STPTS  (22,3)  =0. 

STPTS  (23.3)  =0. 

STPTS  (24, 3) =0. 

STPTS  (25, 3) =0- 
STPTS  (26, 3) =1 • 

STPTS  (27.3)— 1 • 

XG  (1 , 1)  = 0. 

XG  (2,  1)  =0. 

XG  (3, 1)  = 0. 

XG  (4, 1)  =0. 

XG  (1 , 2)  = - .5773502691 896D0 

XG  (2,2)  = .5773502691896DO 

XG  (3,2)  = 0. 

XG  (4 , 2)  =0. 

XG (1 , 3)  = - . 774596669241 5D0 

XG  (2,3)  = 0. 

XG  (3, 3)  = .7745966692415DO 

XG  (4,3)  = 0. 

XG(1,4)  = - . 86 1 1 383 1 1 594 1 DO 

XG  (2,4)  = - - 33998 10435849D0 

XG  (3.4)  = .3399810435849D0 

XG  (4,4)  = .861 13631 15941D0 

WGT  (1,1)  = 2.0 

WGT  (2,1)  =0.0 

WGT  (3,1)  = 0.0 

WGT  (4,1)  =0.0 

WGT  (1,2)  = 1.0 

WGT  (2 , 2)  = 1.0 

WGT  (3,2)  =0.0 

WGT  (4,2)  =0.0 

WGT  (1,3)  = .5555555555556  DO 

WGT  (2,3)  * .8888888888889  DO 

WGT  (3, 3)  = .5555555555556  DO 

WGT  (4 ,3)  =0.0 

WGT  (1,4)  = .3478548451375  DO 

WGT  (2 , 4)  = .6521451548625  DO 

WGT  (3 , 4)  = .6521451548625  DO 

WGT  (4,4)  = .3478548451375  DO 

NT8SV  = MODEX 
DO  10  1=4,6 
DO  10  J=1 ,63 
10  B (I  ,J)  =0.0 


C 


FILE:  PSAP 


FRC 


A OLD  DOMINION  UNIVERSITY 


DO  14  1=1,42 
DO  14  J=1 , 4 
14  SF (I , J) =0 .0 
C 

C PRINT  ELEMENT  CONTROL  VARIABLES 

C 

WRITE  (6,3001)  NUME , NUMMAT , MAXTP , NORTHO, NDLS ,MAXNOD , NOPSET, I NTRS 
1 I NTT 

C 

C READ  AND  CHECK  INPUT  UP  TO  THE  ELEMENT  DATA  CARDS 
C 

CALL  INP21  (NUMMAT, MAXTP, NORTHO, NDLS, NOPSET, NT8SV,NUMNP,X, 

1 Y,Z, DEN, RHO.NTP, EE, DCA, NFACE.LT, PWA, LOC.MAXPTS) 

C READ  ELEMENT  DATA  CARDS 

C 

NREAD  = 8 

IF  (MAXN0D.GT.8)  NREAD  = 21 
C 

WRITE  (6,3014)  (I, 1 = 1, 8) 

I F (MAXN0D.GT.8) 

*WRITE  (6,3016)  (1,1=9,21) 

C 

NEL  = 0 
C 

C CARD  FOR  ELEMENT  NUMBER  ONE  ONLY 
C 

READ  (5,1008)  INEL, ND I S , NXYZ , NMAT, MAXES, IOP.TZ, KG, NRSINT.NTINT 
1 , I REUSE , (LS  ( I ) ,1  = 1,4) 

READ  (5,1009)  (NOD  (I) , 1 = 1 .NREAD) 

IREUSE  = 0 

I F (I  NEL.EQ.  1)  GO  TO  51 
WRITE  (6,4014)  INEL 
WRITE  (6,4014) 

STOP 

C 

C CARDS  FOR  ALL  OTHER  ELEMENTS 

C 

50  READ  (5.1008)  INEL, NDIS, NXYZ, NMAT, MAXES, IOP.TZ, KG, NRSINT.NTINT 
1, IREUSE,  (LS  (I) ,1=1,4) 

READ  (5,1009)  (NOD  (I)  , 1=1  .NREAD) 

C 

C DATA  ADMISSIBILITY  CHECK 

C 

51  IF  (NDIS.EQ.O)  NDIS  = MAXNOD 
IF  (NDIS.LE.MAXNOD)  GO  TO  5051 

WRITE  (6,3015)  INEL, NDIS, NXYZ, NMAT, MAXES, IOP.TZ, KG, NRSINT.NTINT 
1 , I REUSE  , (LS  (I)  ,1-1,4) 

WRITE  (6,4015)  NDIS, MAXNOD 
STOP 

5051  IF (NDIS. GE. 8)  GO  TO  52 
WRITE  (6,4023)  NDIS 
STOP 

52  IF  (NXYZ.EQ.O)  NXYZ  = NDIS 

I F (NXYZ. LE. NDIS)  GO  TO  5052 
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WRITE  (6,4016)  NXYZ.NDIS 
WRITE  (6,4099) 

MODEX  = 1 
GO  TO  53 

5052  IF  (NXYZ.GE.8)  GO  TO  53 
WRITE  (6,4024)  NXYZ 
WRITE  (6,4099) 

MODEX  = 1 

53  I F (NMAT . GE , 1 .AND.  NMAT . LE . NUMMAT)  GO  TO  54 

WRITE  (6,3015)  INEL, NDIS, NXYZ, NMAT, MAXES, IOP.TZ, KG, NRSINT.NTINT 

1 , I REUSE , (LS  ( I ) ,1-1,4) 

WRITE  (6,4017) 

WRITE  (6,4099) 

MODEX  = 1 

54  IF  (MAXES. LE.NORTHO)  GO  TO  55 

WRITE  (6,3015)  I NEL ,ND I S , NXYZ, NMAT, MAXES, I OP.TZ, KG,NRS I NT.NTI NT 
1 , IREUSE,  (LS  (I) , 1 = 1 ,4) 

WRITE  (6,4018) 

WRITE  (6,4099) 

MODEX  = 1 

55  IF  ( I OP . GE .0  .AND.  I OP . LE  . NOPSET)  GO  TO  56 

WRITE  (6,3015)  I NEL ,ND I S ,NXYZ, NMAT, MAXES , IOP.TZ, KG.NRS I NT, NT  I NT 
1 .IREUSE,  (LS  (I)  , 1=1,4) 

WRITE  (6,4019) 

WRITE  (6,4099) 

MODEX  = 1 

56  DO  57  1-1,1* 

I F (LS  (I ) .GE .0  .AND.  LS  ( I ) . LE . NDLS)  GO  TO  57 

WRITE  (6,3015)  INEL, NDIS, NXYZ, NMAT, MAXES, IOP.TZ, KG, NRSINT.NTINT 

1 , IREUSE,  (LS  (J) , J=1 ,4) 

WRITE  (6,4020)  LS ( I ) 

WRITE  (6,4099) 

MODEX  = 1 

57  CONTINUE 
C 

C DEFAULT  VALUES  IF  REQUIRED 
C 

IF  (KG.EQ.O)  KG  = 1 
I F (NRS I NT.EQ.O)  NRS I NT  = INTRS 
IF  (NT  I NT.EQ.O)  NT  I NT  = I NTT 
C 

DO  58  1=1,8 

IF  (NOD  (I)  .GE.  1 .AND.  NOD  ( I ) . LE .NUMNP)  GOTO  58 

WRITE  (6,3015)  INEL, NDIS, NXYZ, NMAT, MAXES, IOP.TZ. KG, NRSINT.NTINT 

1 , IREUSE,  (LS  (J) ,J=1 ,4) 

WRITE  (6,4021)  I , NOD ( I ) 

STOP 

58  CONTINUE 

I F (MAXNOD.LT. 9)  GO  TO  60 
11=0 

DO  59  1=9,21 

I F (NOD  (I)  . EQ.O)  GO  TO  59 

II  = II  +1 
N0D9M  ( I I)  = I 

IF  (NOD  (I)  .LE. NUMNP)  GO  TO  59 
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WRITE  (6,3015)  INEL, ND I S.NXYZ.NMAT, MAXES, IOP.TZ, KG, NRSINT.NTINT 
1 , I REUSE , (LS  (J) , J=T ,4) 

WRITE  (6,1*021)  I , NOD  ( I ) 

STOP 

59  CONTINUE 
C 

1=11+8 

IF (I . EQ.ND I S)  GO  TO  60 
WRITE  (6,1*025)  I.NDIS 
STOP 
C 

60  NEL  = NEL  + 1 
ML  = INEL  - NEL 
IF  (ML)  65,70,80 

65  WRITE  (6,4022)  INEL 
STOP 
C 

C SAVE  THE  DATA  FOR  ELEMENT  NUMBER  * I NEL*  FOR  POSSIBLE  USE  IN 
C OATA  GENERATION 
C 
C 

70  KDIS  = ND  I S 
KXYZ  = NXYZ 
KMAT  = NMAT 
KAXES  = MAXES 
KIOP  = I OP 
TTZ  = TZ 
KKG  = KG 
KRSINT  = NRSINT 
KTINT  = NT  I NT 
KREUSE  = IREUSE 
DO  72  1=1,4 
72  KLS(I)  = LS  ( I ) 

DO  74  1=1 , NRE AD 
74  KOD(I)  = NOD  ( I ) 

TAG  = TGI 
C 

GO  TO  90 
C 

C INCREMENT  THE  NON-ZERO  NODE  NUMBERS  FROM  THE  PRECEEDING  ELEMENT 
C 

80  DO  85  I-1.NREAD 

I F (KOD  (I)  - LT . 1 ) GO  TO  85 
KOD(I)  = KOD  ( I ) + KKG 
85  CONTINUE 
TAG  * TG2 
C 

90  ND  = 3 * KDIS 
C 

C COMPUTE  THE  AVERAGE  ELEMENT  TEMPERATURE  USING  COORDINATE  NODES 
C 

TAV  = 0.0 
DO  95  K-1.KXYZ 
I = KOD  (K) 

95  TAV  = TAV  + T(l) 
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TAV  = TAV  / KXYZ 

PERFORM  TEMPERATURE  INTERPOLATION  FOR  THE  PROPERTY  SET 

NT  = NTP(KMAT) 

IF  (NT.GT.1)  GO  TO  100 

97  DO  98  1=1.12 

98  E (I)  = EE  (1 , 1 + 1 ,KMAT) 

GO  TO  112 

100  IF  (TAV.GE . EE  (1 , 1 , KMAT) ) GOTO  104 
102  WRITE  (6.4030)  TAV, NEL, KMAT 
STOP 

104  I F (TAV.GT.EE  (NT, 1 , KMAT) ) GOTO  102 
I F (TAV.EQ.EE  (1 , 1 ,KMAT) ) GO  TO  97 
C 

I F (MODEX.EQ. 1)  GO  TO  112 
C 

DO  106  K=2 , NT 
K2  = K 
K 1 = K- 1 

I F (TAV.GT.EE  (K1 , 1 ,KMAT)  .AND.  TAV. LE . EE  (K2 , 1 , KMAT) ) GOTO  108 
106  CONTINUE 

108  DT  = EE  (K2 , 1 , KMAT)  - EE  (K 1 , 1 .KMAT) 

RATIO  = (TAV  - EE  (K1 , 1 , KMAT) ) / DT 

110  EO)1-  EE  (Kl!  1 + 1,  KMAT)  + RATIO  * (EE  (K2 , 1 + 1 , KMAT)  -EE  (K 1 , I + 1 , KMAT) ) 
C 

112  CONTINUE 

C FORM  THE  STRESS-STRAIN  LAW  IN  MATERIAL  COORDINATES  AND  TRANSFORM 

C TO  GLOBAL  (X.Y.Z)  COORDINATES 
C 

*CALL°SSLAWQ  (d1e.TEMP.DCA (1 , 1 .KAXES)  , KAXES, KMAT, NEL, DUM, ALPHA) 

C 

c STORE  THE  NODE  COORDINATES  FOR  THIS  ELEMENT 
C 

I F (MODEX.EQ. 1)  GO  TO  410 
C 

DO  130  1=1 , KD I S 
II  = KOD  (I) 

IF (I . LT.9)  GO  TO  125 
JJ  = N0D9M  ( I -8) 

II  = KOD  (JJ) 

125  XX  (1 , I)  = X (I  I) 

XX (2,  I)  = Y (I  I) 

XX  (3,  I)  - Z (I  I ) 

130  CONTINUE 

C COMPUTE  THE  ELEMENT  STIFFNESS,  MASS,  THERMAL  AND  GRAVITY  LOAD 

C MATRICES 
C 

DO  170  1=1,63 
DO  170  J=1 , 4 
170  RF  (I  ,J)=0.0 
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C 

IF  (KREUSE.EQ. 1)  GO  TO  300 
C 

DO  180  l-l.KDIS 
180  DL  (I) -0.0 

DO  190  1-1, ND 
C 

c 

C 1 . THERMAL  LOADS 

C 

190  FT  (I ) =0.0 
KTL  - 0 
DUX  = 0.0 
DO  200  1-1,4 

200  DUX  - DUX  +ABS  (TLF (I)) 

I F (DUX.GT. 1 .0E-06)  KTL  = 1 
IF  (NDYN.GT.O)  KTL-0 
I F (KTL . EQ.O  .OR.  NDYN.GT.O)  GO  TO  235 
C 

C A. INITIAL  STRESS  CONSTANTS 

C 

DO  210  1-1,6 
S I GOT  ( I ) - 0.0 
DO  205  K= 1 , 6 

205  SIGDT(l)  = SIGDT(I)  + D(I,K)*  ALPHA  (K) 

210  CONTINUE 
C 

C B.  VECTOR  OF  NODE  TEMPERATURE  DIFFERENCES 

C 

DO  230  l-l.KDIS 
II  = KOD  (I) 

IF  (I . LT . 9)  GO  TO  220 
J = N0D9M  ( I -8) 

II  - KOD  (J) 

220  DELT(I)  = T(l  I)  - TTZ 
230  CONTINUE 
C 

C C.  CLEAR  THE  THERMAL  LOAD  NODE  FORCE  VECTOR 

C 

C 2.  GRAVITY  LOADS 

C 

235  DUX-0.0 

DO  250  1-1,4 

250  DUX  - DUX  +ABS  (XLF  ( I ) ) +ABS(YLF(I))  +ABS(ZLF(I)) 
KGL  - 0 

IF  (DUX.GT. 1 .OE-6)  KGL  - 1 
IF  (NDYN.GT.O)  KGL-0 
C 
C 

C 3.  MASS  MATRIX 

KMS  = 0 

I F (NDYN.GT.O)  KMS  = 1 


C 


DO  270  K-l.ND 
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C 4.  STIFFNESS  MATRIX 

C 

270  XM  (K)  =0.0 
DO  280  1=1 . ND 
DO  280  K= 1 , ND 
280  SS  (I  ,K)  = 0.0 


C 

C 


CALL  ST8R21  (D 
1 KXYZ , 


,B,SS,XX,N0D9M,H,P,SIGDT,DELT,FT,DL,XM,NEL,ND,KDI 

KTL , KGL , KMS , KRS I NT , KT I NT , DEN (KMAT)  , RHO (KMAT) ) 


S, 


NODE  FORCES  DUE  TO  THERMAL  DISTORTION 

300  IF  (KTL.EQ.O)  GO  TO  325 
DO  320  1=1 , ND 
DO  310  K=l,4 

310  RF  (I  ,K)  = FT  ( I ) * TLF  (K) 

320  CONTINUE 


C 

c 

c 

c 


NODE  FORCES  DUE  TO  STATIC  ACCELERATIONS 


325  IF  (KGL.EQ.O)  GO  TO 
DO  340  I =1 , KD I S 
K3  = 3*1 
K2  = K3-1 
K 1 = K 2 — 1 
DO  330  L=1 ,4 
RF  (K 1 , L)  = RF  (K 1 , L) 
RF  (K2,L)  = RF  (K2.L) 
330  RF  (K 3 » D = RF  (K3.L) 
340  CONTINUE 


350 


+ XLF  (L)  *DL  ( I ) 

+ YLF  (L)*  DL  (I) 
+ ZLF  (L)  * DL  (I) 


COMPUTE  NODE  FORCES  DUE  TO  ELEMENT  SURFACE  LOADINGS 
350  IF  (NDLS.LT.l .OR.NDYN.GT.O)  GO  TO  405 


DO  400  L= 1 , 4 

I F (PLF  (L)  .EQ.O.O)  GO  TO  400 
M = KLS  (L) 

IF  (M.LT.l)  GO  TO  400 
DO  360  K=1 ,ND 


C 


360  PL  (K)  = 0.0 

CALL  FACEPR  (NEL , KD I S , KXYZ . XX , N0D9M.H, P ,PL, 
1 PWA(l.M).M) 


NFACE(M)  , LT  (M)  , 


C 

DO  370  1=1, ND 

C 370  RF  ( I , L)  = RF(I.L)  + PL(D*  PLF  (L) 

400  CONTINUE 
405  CONTINUE 

C ASSIGN  EQUATION  NUMBERS  TO  THE  ELEMENT  DEGREES  OF  FREEDOM 
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C 

410  K = -3 

DO  420  I = 1 , KD  I S 
II  = KOD  (I) 

I F (I .LT.9)  GO  TO  415 
JJ  = N0D9M(l-8) 

II  = KOD  (JJ) 

415  K = K+3 

DO  420  L=1 ,3 
M = K+L 

420  LM  (M)  = 10(1  I .L) 

C 

IF (K I OP.GT.O)  NS  = 6*MAXPTS (K I OP) 

IF (KIOP.EQ.O)  NS  * 6 
IF  (NDYN.GT.O)  NS=42 
C 

C SAVE  STIFFNESS  AND  LOAD  MATRICES 

C 

CALL  CALBAN  (MBAND , ND I F , LM, XM, SS , RF , ND ,63, NS) 

C 

C COMPUTE  STRESS  RECOVERY  MATRICES 

C 

I F (NDYN.LT. 1)  GO  TO  425 
N0P=7 

DO  422  1=1,7 
422  LOCOP  ( I ) = I + 20 
GO  TO  450 

425  IF  (KIOP.EQ.O)  GO  TO  440 
NOP  = MAXPTS (KIOP) 

DO  430  1=1 , NOP 
430  LOCOP  (I ) = LOC  ( I . K I OP) 

GO  TO  450 
440  NOP  = 1 

LOCOP  ( 1 ) = 21 
C 

450  IF  (MODEX.EQ.l)  GO  TO  5 10 
C 

C CONSIDER  EACH  OUTPUT  LOCATION 
C 

DO  500  L= 1 , NOP 
C 

M=  LOCOP  (L) 

El*  STPTS(M.I) 

E2-  STPTS (M, 2) 

E3«  STPTS  (M, 3) 

C 

C COMPUTE  THE  STRAIN-DISPLACEMENT  MATRIX  AT  THIS  LOCATION 
C 

CALL  DER3DS  (MEL , XX , B, DET, E 1 , E2 , E3, N0D9M, H, P, KD I S, KXYZ) 
C 

DO  470  1-1,6 
N=  6*(L-1)  + I 
DO  465  J-l , ND 
Q = 0.0 
DO  460  K-1,6 
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1*60  Q * Q + D (I  ,K)  * B (K,J) 

1*65  SDT(N.J)  = Q 
1*70  CONTINUE 
c 

C FORM  THE  INITIAL  STRESS  CORRECTIONS  DUE  TO  THERMAL  LOADS 
C 

I F (KTL . EQ.O  .OR.  NDYN.GT.O)  GO  TO  500 
C 
C 

c 1.  TEMPERATURE  DIFFERENCE  AT  THIS  LOCATION 

C 

Q = 0.0 

DO  480  K=1 , KD I S 
C 

C 2.  VECTOR  OF  INITIAL  STRESSES 

C 

1*80  Q = Q + H (K)  * DELT(K) 

DO  485  K=1 ,6 

485  VIS  (K)  = -Q  * SIGDT  (K) 

C 

DO  490  1=1,6 
N = 6* (L- 1) +1 


C 


c 

c 

c 

c 

c 

c 


DO  490  K=1 , 4 

490  SF  (N  , K)  = VIS  (I)  * TLF  (K) 

500  CONTINUE 

SAVE  THE  STRESS  RECOVERY  ARRAYS 


510  CONTINUE 


I F (MODEX.EQ.O) 

1WRITE  (1)  ND , NS , (LM ( I ) , I = 1 ,ND)  , ( (SDT  ( I , J) 
2 ((SF  (I ,J)  , 1 = 1, NS)  ,J=1 ,4) 


1=1 , NS) ,J=1 ,ND) 


C 

C PRINT  DATA  FOR  THE  CURRENT  ELEMENT 

1 write  (6,3015)  NEL,KDIS,KXYZ,KMAT,KAXES,KIOP,TTZ,KKG,KRSINT,KTINT, 

1 KREUSE.KLS 

WRITE  (6,3017)  (KOD(I)  , 1=1, NREAD) 


C 

C***  DATA  PORTHOLE  SAVE 
IF (NT8SV.EQ.1) 

1WRITE  (NT8)  NEL,KDIS,KXYZ,KMAT,KAXES,KIOP,TTZ, 

2 KREUSE.KLS, NREAD, 

3 (KOD  (I)  , 1-1  .NREAD) 

C*** 


KRS I NT , KT I NT, 


C 

C CHECK  FOR  THE  LAST  ELEMENT 
C 

I F (NUME-NEL)  65,600,530 
530  IF  (ML)  50,  50,  60 


C 
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600  RETURN 
C 

C FORMATS 
C 

1008  FORMAT  (615. F10. 0,1*15, 412) 

1009  FORMAT  (1615) 

C 


3001  FORMAT  ( 7X , 3^HNUMBER  OF  21-NODE  ELEMENTS  = 16// 

1 7X.34HNUMBER  OF  MATERIAL  SETS  = 16// 

2 7X.26HMAXIMUM  NUMBER  OF  MATERIAL,  / 

3 7X,31*HTEMPERATURE  INPUT  POINTS  - |6  // 

4 7X, 1 8HNUMBER  OF  MATERIAL,  / 

5 7X , 34HAX I S ORIENTATION  SETS  = |6// 

* 7X.34HNUMBER  OF  DISTRIBUTED  LOAD  SETS  - 1 6// 

6 7X.34HMAXIMUM  NUMBER  OF  ELEMENT  NODES  = 1 6 // 

7 7X.34HNUMBER  OF  STRESS  OUTPUT  SETS  — 1 6 // 


8 7X.34HR.S  COORDINATE  INTEGRATION  ORDER  * l6  // 

9 7X.34HT  COORDINATE  INTEGRATION  ORDER  -=l6  //  IX) 

3014  FORMAT  (52H13  / D 8 TO  21  NODE  SOLID  ELE, 

1 18H  M E N T DATA,//  8H  ELEMENT  2 (2X .5HN0DES) ,2  (2X , 

2 5HMATL.) , 2X , 6HSTRESS , 4X , 6H STRESS , 2X, 4HN0DE ,2  (2X.5HGAUSS)  ,6X, 

3 2HK-,5X,3HLSA,3X,3HLSB,3X,3HLSC,3X,3HLSD,  / 

4 8H  NUMBER, 7H  -NDIS-.7H  -NXYZ- , 2X, 5HTABLE , 3X, 4HAXES , 2X , 6H0UTPUT, 

5 6X.4HFREE.2X.4HINC. ,2  (3X.4HPTS.) ,2X,6HMATRIX,2X,4 (2X.4H-0R-) , / 

6 26X, 3HN0. .4X,3HSET,5X,3HSET,5X,5HTEMP. ,2X,4H-KG-,2X,5H-R,S-,4X, 

7 3H-T-,2X,6HRE-USE,2X,  8 (2X , 2HN- , I 2)  ) 

3015  FORMAT  (18,417, 18, F10.1, 16,217, 18, 2X, 416) 

3016  FORMAT  (84X, 8 (2X, 2HN- , I 2)  / 84X,5 (2X.2HN-, I 2)  ) 

3017  FORMAT  (84X , 8 1 6 / 84X,8l6,/  84X.5I6) 

C 

4014  FORMAT  (33H0ERR0R***  ENCOUNTERED  ELEMENT  (J5.13H),  BUT  EXPECT, 

1 2 1 H TO  READ  ELEMENT  ONE.,  / IX) 

4015  FORMAT  (42H0ERR0R***  NUMBER  OF  DISPLACEMENT  NODES  ( , 1 5 , 4H)  IS, 

1 30H  LARGER  THAN  MAXIMUM  ALLOWED  (,I5,2H).,  / IX) 

4016  FORMAT  (40H0ERR0R***  NUMBER  OF  COORDINATE  NODES  ( , 1 5 , 6H)  MUST, 

1 39H  BE  .LE.  NUMBER  OF  DISPLACEMENT  NODES  ( , 1 5 , 2H)  . ) 

4017  FORMAT  (36HOERROR***  ILLEGAL  MATERIAL  NUMBER.  ) 

4018  FORMAT  (44HOERROR***  ILLEGAL  MATERIAL  AXIS  REFERENCE.  ) 

4019  FORMAT  (41H0ERR0R***  ILLEGAL  OUTPUT  SET  REFRENCE.  ) 

4020  FORMAT  (4 1HOERROR***  PRESSURE  LOAD'  SET  REFERENCE  (,I5,4H)  IS, 

1 9H  ILLEGAL.  ) 

4021  FORMAT  (1 6H0ERR0R***  THE  ,12,1 8H-TH  ELEMENT  NODE  (, 1 5 , 4H)  IS, 

1 9H  ILLEGAL.,/  IX) 

4022  FORMAT  (28HOERROR***  ELEMENT  NUMBER  ( , 1 5 , 1 1 H)  IS  OUT  OF, 

1 10H  SEQUENCE.,  / IX) 

4023  FORMAT  (42H0ERR0R***  NUMBER  OF  DISPLACEMENT  NODES  (.15, 

1 25H)  MUST  BE  AT  LEAST  EIGHT.  ) 

4024  FORMAT  (40H0ERR0R***  NUMBER  OF  COORDINATE  NODES  (,I5, 

1 25H)  MUST  BE  AT  LEAST  EIGHT.  ) 

4025  FORMAT  (38HOERROR***  NUMBER  OF  NON-ZERO  NODES  (, 1 3 , 6H)  READ, 

1 50H  DOES  NOT  EQUAL  THE  NUMBER  OF  DISPLACEMENT  NODES  (, 

2 13, 2H)  .,/  IX) 

4030  FORMAT  (33H0ERR0R***  AVERAGE  TEMPERATURE  (,F10.2,5H)  FOR, 

1 10H  ELEMENT  (.I5.29H)  OUT  OF  RANGE  FOR  MATERIAL  (, I 3 , 

2 2H)  . , / IX) 
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4099  FORMAT  ( 1 2 X , 3 1 HPROCEED  IN  DATA  CHECK  ONLY  MODE,  / IX) 

C 

END 

SUBROUTINE  THREED 
C 
C 

C CALLS?  BRICK8.STRSC, PRIST 

C CALLED  BY?  ELTYPE 

C COMMON  /ELPAR/  NPAR  ( 1 4) , NUMNP ,MBAND , NELTYP ,N1,N2,N3,N4,N5. MTOT, NEQ 
COMMON  /EM/  NS  ,ND , B (42 , 63)  ,TT  (42 , 4)  , LM  (63) 

EQUIVALENCE  (IS1,TT(4))  , ( I S2  ,TT  (6) ) 

COMMON  /JUNK/  LT , LH , L , I PAD , S I G (24) , N6, N7 » N8, N9, N 10, N 1 , 

1 N12, IFILL  (371) 

COMMON  /EXTRA/  MODEX,NT8,N10SV,NT10, I F I LL2 (12) 
common  /say/  neqq , numee , 1 oopur , nnbl ock , nterms , opt i on 
common  /what/  naxa  (10000) , i rowl  (10000) , icolh  (10000) 

COMMON  /one/  A (1) 

DIMENSION  SPR  (6) 


C 


C 


C 


IF  (NPAR  ( 1 ) . EQ.O)  GO  TO  500 

N6=N5+NUMNP 

N7=N6+NPAR(3) 

N8=N7+NPAR (3) 

N9=n8+npar  (3) 

N10=N9+NPAR (3) 

N 1 1=N 1 0+NPAR  (4) 

N 1 2=N 1 1+NPAR (4) 

N 1 3=N 1 2+NPAR (4) 

N 1 4=N  1 3+NPAR  (4) 

N 1 5=N 1 4+33*33 

N16=N15+12*33 

I F (Nl6.GT.MT0T)  CALL  ERROR  (N16-MT0T) 


CALL  BRICK8 

1 

2 


(A  (N 1 4)  , A (N 1 5)  , NPAR  (2)  , NPAR  (3)  , NPAR  (4)  ,A(N1)  ,A(N2)  , 
A(N3)  , A (N4)  ,A(N5)  , A (N6)  ,A(N7)  ,A(N8)  ,A(N9)  ,A(N10)  , 

A (N 1 1)  , A (N 1 2)  , A (N 1 3)  , NUMNP) 


RETURN 


C 


500  WRITE  (6,2005) 

NUME=NPAR (2) 

DO  800  MM-l.NUME 
CALL  STRSC  (A  (Nl)  , A (N3)  ,NEQ,0) 
C***  STRESS  PORTHOLE 
I F (N10SV.EQ.  1) 

*WRITE  (NT  10)  NS 
WRITE  (6,2000) 

DO  800  L-LT.LH 


C*** 


.1*1,6)  , (SPR  (I)  , 1-1, 


CALL  STRSC  (A  (Nl)  , A (N3)  ,NEQ,  1) 

CALL  PRIST  (NS, IS1 , IS2.SIG.SPR) 

WRITE  (6,3005)  MM,  L,  I SI  , (S  I G (I) 

STRESS  PORTHOLE 

IF  (N10SV.EQ.1)  , , ,, 

*WR I TE  (NT10)  MM, L , I S 1 , (S I G ( I ) , 1=1,6) , (SPR  (I ) ,1*1*3) 


3) 
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I F (N10SV.EQ. 1 .AND.  NS.EQ. 12) 

*WR  I TE  (NT  10)  IS2,  (SIG(I)  , 1=7,  12)  , (SPR(I)  , 1=4,6) 

I F (NS . EQ. 12)  WRITE  (6,3015)  I S2,  (S I G (I ) , 1=7, 12) , (SPR  (I ) , I =4,6) 
800  CONTINUE 
C 

RETURN 

C 

2000  FORMAT  (/) 

2005  FORMAT  (36HI 8-NODE  SOLID  ELEMENT  STRESSES  // 

. 24H  ELEMENT  LOAD  NO.  FACE  ,5X, 

104H  SIG-XX  SIG-YY  SIG-ZZ  SIG-XY  SIG-YZ 

SIG-ZX  SIG-MAX  SIG-MIN  S2/ANGLE) 

3005  FORMAT  (16, 19, I8.2X, 1P9E12.2) 

3015  FORMAT  ( 1 5X , I8.2X, 1P9E12.2) 

END 

SUBROUTINE  TPLATE  (NUMEL , NUMMAT, I D,X,Y,Z,C,NUMNP,MBAND) 

C 

C CALLS?  QTSHEL, STRETR, CALBAN 

C CALLED  BY?  SHELL 

C 

COMMON/QTSARG/ 

1XX  (5)  ,YY  (5)  ,ZZ  (5)  , HM  (5)  , HP  (5)  , CM  (3,3)  .ALFA  (3)  ,HW(5)  ,RHO  (5,3)  ,P  (5) 
2,  T(5)  , DT  (5)  , SM  (5, 3)  , BM  (5, 3)  ,TDIS(36)  .TROT  (36)  ,S(30,30)  ,R(30) 
COMMON/EM/LM  (24) , ND , NS , ASA (24,24) , RF (24,4)  ,XM(24) ,SA (12,24) 

1 ,SF  (12,4)  ,PF  (24)  , IFILL1  (3000) 

COMMON  /EXTRA/  M0DEX.NT8, I F I LL2 (14) 

DIMENSION  X (1)  , Y (1)  ,Z  (1)  , I D (NUMNP,  1)  , C (1 2 , 1)  , I X (7)  , I Y (7)  , EL  (4) 

1,  TLO  (5 , 4) 

common  /say/  neqq , numee, 1 oopur , nnb 1 ock , nterms,opt i on 
common  /what/  naxa  (10000) , i rowl  (10000) , icolh  (10000) 

C 

LL  =4 

NDM  = 24 
MTYPE  = 6 
I STOP  = 0 
NS  =6 

C DEGREES  OF  FREEDOM  PER  NODE 
NPF  = 6 

C MID-SIDE  NODES 

MID  = 0 

C GLOBAL  REFERENCE  FOR  DISPLACEMENTS/ROTATIONS 

IDIS  = 0 
I ROT  =0 
C 

WRITE  (6,2000)  MTYPE, NUMEL, NUMMAT 
C 

C ***  READ  AND  PRINT  OF  MATERIAL  PROPERTIES 
C 

WRITE  (6,2001) 

DO  10  N=l, NUMMAT 

READ  (5,1000)  K,  (C  (I, K) ,1  = 1,12) 

10  WRITE  (6,2002)  K,  (C  (I , K) , 1=3, 12) 

C***  DATA  PORTHOLE  SAVE 
IF  (MODEX.EQ.l) 

AWRITE  (NT8)  { (C  ( I , N)  ,1  = 1,12)  , N= 1 , NUMMAT) 
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C 

C ***  READ  AND  PRINT  OF  ELEMENT  LOAD  MULTIPLIERS 
C 

READ  (5,1002)  ( (TLO  ( I , J)  , J=1 , 4)  ,1=1,5) 

WRITE  (6,2006) 

WRITE  (6,2007)  (J,  (TLO(I.J)  ,1-1,5)  .J-M) 
C***  DATA  PORTHOLE  SAVE 
IF  (MODEX.EQ.l) 

*WRITE  (NT8)  TLO 
C 

C ***  READ  AND  PRINT  OF  ELEMENT  DATA 
C 

WRITE  (6,2003) 

NN=0 

100  READ  (5. 1001)  MM, I Y,EL 
110  NN=NN+1 

IF  (MM-NN)  440,50,60 
50  DO  45  1*1,7 
45  I X ( I ) = I Y ( I ) 

I NCL*  I Y (7) 

IF  ( I Y (6)  .EQ.O)  I Y (6) = 1 
I M=  I Y (6) 

I F (I NCL. EQ.O)  I NCL= 1 
NNS=5 

IF  (IY (5)  .EQ.O)  NNS=4 
IF  (IY (4) .EQ.O)  NNS=3 
RHOM=C (3, IM) 

ALFA  (1)  =C  (4,  IM) 

ALFA  (2)  =C  (5, 1 M) 

ALFA  (3)  =C  (6 , I M) 

CM  (1  , 1)  =C  (7,  IM) 

CM  (1  , 2)  =C  (8,  I M) 

CM  ( 1 , 3)  =C  (9,  IM) 

CM  (2 , 2)  =C  (10,  I M) 

CM  (2, 3)  =C  (1  1 , IM) 

CM  (3,3)  =C(12,  IM) 

CM (2,1) -CM  (1,2) 

CM  (3, 1)  -CM  (1 , 3) 

CM  (3, 2) -CM  (2, 3) 

C 

DO  30  1*1,5 
HM  ( I ) *EL  (1) 

HP(I)-EL(1) 

HW(I)-EL(1) 

30  CONTINUE 
GO  TO  70 
C 

60  DO  65  1*1, NNS 
65  IX(I)  = IX(I)  + I NCL 
C 

70  DO  40  1*1 , NNS 
P ( I ) = 0.0 
DO  72  K-1,3 
RHO  (I  , K)  = 0.0 
SM  ( I , K)  * 0.0 
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72  BN  (I  ,K)  = 0.0 
J-IX(I) 

XX  ( I ) =X  (J) 

YY(I)-Y  (J) 

40  ZZ(I)-Z(J) 

C 

C FORM  SHELL  GLOBAL  STIFFNESS  MATRIX 
C 
C 
C 

CALL  QTSHEL  (- 1 , NNS , NPF , M I D , I D I S , I ROT, NO ,NTF) 

C 

C CLEAR  STRESS  CORRECTION  AND  LOAD  VECTOR  MATRICES 
C 

DO  520  L-l.LL 
DO  514  1=1, NS 
514  SF  (I ,L)  = 0.0 
DO  516  J= 1 , ND 
516  RF  (J  , L)  = 0.0 

I F (MODEX.EQ. 1)  GO  TO  200 
520  CONTINUE 
C 

C FORM  ELEMENT  MASS,  STRESS/DISPLACEMENT  AND  UNIT  NORMAL  PRESSURE 
C FORCE  MATRICES 

C 

CALL  STRETR  (NNS.RHOM) 

C 

C FORM  LOAD  VECTORS  AND  STRESS  CORRECTION  MATRICES 

C 

DO  550  IL-l.LL 
C 

C CHECK  FOR  NO  ELEMENT  LOADINGS 

DUM  = 0.0 
DO  522  K=1 ,5 

522  DUM  = DUM  +ABS  (TLO  (K , I L) ) 

IF  (DUM.LT. 1 .OE-8)  GO  TO  550 
C 

C GENERATE  ELEMENT  LOADS  (MECHANICAL) 

C 

DO  524  1=1, NNS 
K = 6*  (I  - 1) 

DO  523  J-1,3 

K = K+l 

RF(K.IL)  = XM  (K)  * TLO  (J+2 , I L)  + PF  (K)  * TLO(I.IL)*  EL  (2) 

523  CONTINUE 

TO)  * TLO  (2,  I L)*  EL  (3) 

DT(I)  — TLO  (2,1  L)*  EL  (4) 

524  CONTINUE 

GENERATE  ELEMENT  LOADS  (THERMAL) 

DUM  =ABS(T(1))  +ABS  (DT  (1) ) 

I F (DUM.LT. 1 .OE-8)  GO  TO  550 
DO  525  1*1 > NNS 
DO  525  K-1,3 


c 

c 

c 
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C 

c 


c 

c 

c 


SM  ( I , K)  =0.0 

525  BM  ( I , K)  = 0.0 

CALL  QTSHEL  (1 , NNS , NPF ,M I D , I D I S , I ROT, ND ,NTF) 

DO  526  1=1 , ND 

526  RF  (I  , IL)  = RF  (I  , IL)  + R ( I ) 

DO  527  J-1.30 

527  R (J)  = 0.0 

ELEMENT  STRESS  CORRECTION  MATRICES 
DO  528  1=1 ,NNS 
DT ( I ) = -DT  ( I ) 

DO  528  K-1,3 
SM  ( I , K)  = 0.0 

528  BM  ( I , K)  = 0.0 

CALL  QTSHEL  (2 , NNS , NPF , Ml D , I D I S , I ROT , ND , NTF) 

AVERAGE  NODAL  STRESSES  AT  THE  ELEMENT  CENTROID 

DO  530  1=1 , NNS 
DO  530  K= 1 , 3 

SF  (K  , IL)  = SF  (K  , I L)  + SM  ( I ,K) 

SF  (K+3 , I L)  = SF  (K+3 , I L)  + BM(I.K) 

DUM  = 1 .O/DFLOAT (NNS) 

DO  532  K-1,6 

SF  (K,  IL)  = SF  (K,  IL)*  DUM 

CONTINUE 
GO  TO  210 

DATA  PORTHOLE  SAVE 
WRITE  (NT8)  NN,  (IX  (I)  , 1 = 1 ,6)  ,EL 
CONTINUE 

WRITE  (6,2004)  NN , ( I X ( I ) ,1  = 1,6) , EL 
FORM  LM  ARRAY  AND  COMPUTE  BANDWIDTH 


530 


532 

C 

550 

C 

c*** 

200 

210 


C 

c *** 
c 


L = Ml  NO  (NNS,  4) 

DO  410  1=1 ,L 
J=NPF* I -NPF 
N=  I X (I) 

00  410  K-l.NPF 
410  LM  (J+K)  = I D (N , K) 

IF  (MODEX  .EQ.  1)  ND=NPF*MI NO (NNS , 4) 

IF  (MODEX.EQ.l)  GO  TO  224 
DO  222  1=1 , ND 
DO  222  J=l , ND 
ASA(I  ,J)  = S (I  ,J) 

222  ASA  (J,  I)  = S (I  , J) 

224  CONTINUE 

CALL  CALBAN  (MBAND , ND I F , LM, XM, ASA ,RF ,ND .NDM.NS) 
IF  (MODEX.EQ.l)  GO  TO  500 
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WRITE  (1)  ND.NS,  (LM(I)  , 1 = 1 ,ND)  , ( (SA  (I  ,J)  , 1=1  ,NS)  ,J=1  ,ND)  , 

1  ( (SF  (l  ,J)  , 1=1  ,NS)  , J = 1 ,4) 

GO  TO  500 

41*0  WRITE  (6,2005)  MM 
I ST0P=1 

500  I F (NN.LT.MM)  GO  TO  110 
IF  (NN . EQ.NUMEL)  RETURN 
IF  ( I STOP . EQ. 1 ) STOP 
GO  TO  100 
C 

2000  FORMAT  (50H1T  HIN  PLATE/SHELL  ELEMENTS,// 

1 22H  ELEMENT  TYPE  =,  15  / 

2 22H  NUMBER  OF  ELEMENTS  =,  15  / 

3 22H  NUMBER  OF  MATERIALS  «,  15  ////  IX) 

1000  FORMAT  (I  10.6F 10.0/6F 10 .0) 

2001  FORMAT  (24H  MATERIAL  PROPERTY  TABLE.  //  9H  MATER  I AL , 8X , 4HMASS , 4X , 

1 7HTHERMAL , 2X.9HEXPANS I ON, 2 X, 1 2HC0EFF I Cl  ENTS, 14X.3H/  /,2X, 

2 13HE  L A S T I C,i*X,17HC  0 N S T A N T S,2X,3H/  /,  / 3X.6HNUMBER. 

3 5X,7HDENSITY,i*X,8HALPHA(X)  ,4X,8HALPHA  (Y)  , 4X , 8HALPHA  (Z)  ,7X, 

4 5HC(XX)  ,7X,5HC(XY)  , 7X.5HC  (XG)  ,7X,5HC(YY)  ,7X,5HC(YG)  ,7X,5HG(XY)  , 

5 /IX) 

2002  FORMAT  (I  9, 1 P 10E 1 2 . 3) 

1002  FORMAT  (4F10.0) 

2006  FORMAT  (30H 1 ELEMENT  LOAD  CASE  MULTIPLIERS,  //  1 3H  ELEMENT  LOAD 

1 4X,8HPRESSURE,5X,7HTHERMAL,13X,2HX-,13X,2HY-,13X,2HZ-,  / 

2 1 3H  CASE  NUMBER, 17X.7HEFFECTS,  3 (3X, 1 2HACCELERAT I ON)  , / IX) 

2007  FORMAT  (6 X , I 1 , 6X , 2F 1 2 . 3 , 3F 15 • 3) 

2003  FORMAT  (32H1THIN  PLATE/SHELL  ELEMENT  DATA,  //  8H  ELEMENT,  42X, 

1 8HMATERI AL,4X,7HAVERAGE,4X,6HN0RMAL,2X, 1 1HTEMPERATURE.5X, 

2 7HTHERMAL,  / 8H  NUMBER, 2X , 6HN0DE- I , 2X, 6HN0DE-J , 2X, 6HN0DE-K , 2X , 

3 6HN0DE-L,2X,6HN0DE-0,4X, 6HNUMBER, 2X.9HTH ICKNESS,2X,8H PRESSURE, 

4 3X.10HDIFFERENCE, 4X, 8HGRAD I ENT , / IX) 

1001  FORMAT  (8 1 5, 4F 1 0 .0) 

2004  FORMAT  (6  I 8 , I 10, F 1 1 . 4 , F 10 . 1 , F 1 3 . 2 , F 1 2 . 3) 

2005  FORMAT  ( 1 9H0CARD  FOR  ELEMENT  (J5.14H)  IS  IN  ERROR.,  / IX) 

C 

END 

SUBROUTINE  TRFPRD  (M, NEN , Q 1 , Q2 , Q3 , P 1 , P2 , P3) 

C 

C CALLED  BY?  STRETR.QTSHEL 
C 

C THIS  SUBROUTINE  GENERATES  THE  TRANSFORMATIONS  RELATING  A LOCAL 

C SUBTRIANGLE  SYSTEM  TO  THE  NODAL  D I S/ROT  SYSTEMS  AT  ITS  3 CORNERS 

COMMON  /TRANSF/  T1  (3)  ,T2  (3)  ,T3  (3)  , T (9) 

DIMENSION  PI  (1)  , P2  (1)  , P3(l),  Q1  (1)  , Q2(l),  Q3(l) 

EQUIVALENCE  (T11.T1  (1))  , (T12.T1  (2))  , (T13.T1  (3)),  (T2 1 , T2  ( 1 ) ) , 

1 (T22.T2  (2) ) , (T23,T2(3))  , (T31,T3(1))  . (T32.T3  (2) ) , (T33.T3  (3) ) 

DO  300  I - 1,3 
J ■ I + 3 
K * I + 6 
PI  (I)  - T1  (I) 

PI  (J)  - T1  (I) 

P 2 ( I ) * T2 ( I ) 

P2(J)  = T2  ( I ) 
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P3(l)  = T3  (I) 

P3(J)  = T3(D 

IF  (NEN.NE.4)  GO  TO  150 
Cl  - T(l) 

CJ  = T (J) 

CK  - T(K) 

IF  (M)  260,260,240 

150  IF  (M)  180,180,200 

180  PI  (K)  = T1  (I) 

P2(K)  = T2  ( I ) 

P3(K)  - T3(l) 

GO  TO  300 


200  Cl  = Q3  0) 

CJ  = Q3(J) 

CK  = Q3(K) 

240  PI  0)  = Til *Q1  (I) 
PI  (J)  = T1  1*Q2  (I) 
P2  (I)  = T21*Q1  (I) 
P2  (J)  = T21*Q2(I) 
P3  (I)  * T31*Q1  (I) 
P3(J)  = T31*Q2(I) 
260  PI  (K)  = T1 1*CI 
P2(K)  = T2  1 *C  I 
P3(K)  = T31  *C  I 
300  CONTINUE 
RETURN 
END 


T12*Q1  (J) 
T12*Q2  (J) 
T22*Q  1 (J) 
T22*Q2  (J) 
T32*Q1  (J) 
T32*Q2  (J) 
T12*CJ 
T22*CJ 
T32*CJ 


T 1 3*Q  1 (K) 
T1 3*Q2  (K) 
T23*Q1  (K) 
T23*Q2  (K) 
T33*Ql  (K) 
T33*Q2  (K) 
T1 3*CK 
T23*CK 
T33*CK 


SUBROUTINE  TRIFAC  (A,B,MAXA,NEQB,MA,NBLOCK,NWA,NTB,NEQ,MI) 


C 

C CALLED  BY?  STEP 

C THIS  ROUTINE  DECOMPOSES  THE  SYSTEM  MATRIX  IN  BLOCKS 

c 

DIMENSION  A (NWA) ,B  (NWA)  ,MAXA  (Ml) 

c 

COMMON  /TAPES/  NSTI F .NRED.NL.NR, I F I LL  (2) 

C 

MA2=MA  - 2 
IF  (MA2.EQ.0)  MA2  = 1 
I NC=NEQB  - 1 
C 

C SET  TAPE  ASSIGNMENTS 
C 

NSTIF  - 4 
NRED  - 3 
NL  - 1 
NR  “7 
C 

Nl-NL 

N2-NR 

REWIND  NSTIF 
REWIND  NRED 
REWIND  N 1 
REWIND  N2 


C 
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C MAIN  LOOP  OVER  ALL  BLOCKS 

DO  600  NJ=1 , NBLOCK 
IF  (NJ.NE.l)  GO  TO  10 
READ  (NSTIF)  A 
GO  TO  100 

10  IF  (NTB.EQ.l)  GO  TO  100 
REWIND  N 1 
REWIND  N2 
READ  (Nl)  A 
C 

C FIND  COLUMN  HEIGHTS 

100  KU-1 

KM-MI NO  (MA.NEQB) 

MAX A ( 1 ) =1 
DO  1 10  N-2 , M I 
IF  (N-MA)  120,120,130 
120  KU-KU  + NEQB 
KK=KU 

MM  = Ml  NO  (N, KM) 

GO  TO  HO 
130  KU-KU  + 1 
KK-KU 

IF  (N-NEQB)  HO,  HO,  136 
136  MM=MM  - 1 
HO  DO  160  K=1  ,MM 

IF  (A  (KK) ) 110,160,110 
160  KK=KK  - INC 
110  MAXA  (N) =KK 

I F (A  (1) ) 172,174,176 
174  KK  = (NJ-1)*NEQB  +1 

I F (KK.GT.NEQ)  GO  TO  590 
WRITE  (6,1000)  KK 
STOP 

172  KK  = (NJ-1)*NEQB  +1 
WRITE  (6,1010)  KK 
C 

C FACTORIZE  LEADING  BLOCK 

176  DO  200  N-2.NEQB 
NH-MAXA (N) 

IF  (NH-N)  200,200,210 
210  KL-N  + INC 
KU-NH 
K=N 
D-0 . 

DO  220  KK-KL.KU, INC 

K-K  - 1 

C-A  (KK)  /A  (K) 

D-D  + C*A(KK) 

220  A (KK)  -C 

A (N)  -A  (N)  - D 
C 

IF  (A  (N) ) 222,224,230 
224  KK-  (NJ-1) *NEQB  + N 

IF  (KK.GT.NEQ)  GO  TO  590 
WRITE  (6,1000)  KK 
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STOP 

222  KK  = (NJ-1) *NEQB  +N 
WRITE  (6,1010)  KK 

: 

230  I C=NEQB 

DO  240  J*1 , MA2 
MJ=MAXA (N+J)  - 1C 
IF  (MJ-N)  2L0.240.280 
280  KINMINO  (MJ.NH) 

KN=N  + 1C 
C=0 . 

DO  300  KK=KL , KU , INC 
300  C=C  + A (KK) *A  (KK+I C) 

A (KN)  =A  (KN)  - C 
240  I C= I C + NEQB 
C 

200  CONTINUE 
C 

C CARRY  OVER  INTO  TRAILING  BLOCKS 

320  DO  400  NK=1 , NTB 

IF  ( (NK+NJ)  .GT.NBLOCK)  GO  TO  400 

N I =N  1 

IF  ((NJ.EQ.l)  .OR.  (NK.EQ.NTB))  NI=NSTIF 

READ  (Nl)  B 

ML=NK*NEQB  + 1 

MR*MI NO ( (NK+ 1 ) ANEQB.MI) 

MD  = Ml -ML 

KL=NEQB  + (NK-1) *NEQB*NEQB 
N=  1 
C 

DO  500  M=ML .MR 
NH=MAXA (M) 

KL=KL  + NEQB 
IF(NH-KL)  505,510.510 
510  KU=NH 
K=NEQB 
D=0 . 

DO  520  KK=KL , KU , INC 
C=A  (KK)  / A (K) 

D=D  + C*A  (KK) 

A (KK)  =C 
520  K*K  - 1 

B(N)-B(N)  - D 
IF  (MD)  500,500,530 
530  IC-NEQB 

DO  540  J-l ,MD 
MJ“MAXA  (M+J)  - 1C 
IF  (MJ-KL)  540,550,550 
550  KU-MI NO (MJ ,NH) 

KN-N  + I C 
C-0. 

DO  575  KK-KL.KU, INC 
575  C-C  + A(KK)*A(KK+IC) 

B (KN)  =B  (KN)  - C 
540  I C= I C + NEQB 
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505  MD  * MD-1 
C 

500  N=N  + 1 
C 

IF  (NTB.NE.l)  GO  TO  56O 
WRITE  (NRED)  A , MAXA 
DO  570  1*1 ,NWA 
570  A ( I ) =B  ( I ) 

GO  TO  600 

560  WRITE  (N2)  B 

C 

*♦00  CONTINUE 
C 

M*N  1 
N 1 =N2 
N2=M 

590  WRITE  (NRED)  A , MAXA 

C 

600  CONTINUE 
C 

1000  FORMAT  (UHOSTOP.  ZERO  PIVOT  ENCOUNTERED  AT  EQUATION  ( 15  1H)  ) 
1010  FORMAT  (52H0WARN I NG . NEGATIVE  PIVOT  ENCOUNTERED  DURING  MATRIX 
1 35H  DECOMPOSITION  AT  EQUATION  NUMBER  (,I5,1H),  IX) 

RETURN 

END 

SUBROUTINE  VECTOR  (V.XI ,YI ,ZI .XJ.YJ.ZJ) 

C 

C CALLED  BY?  PLNAX, QUAD 
C 

DIMENSION  V(*0 
X=XJ-XI 
Y=YJ-YI 
Z= ZJ-ZI 

V (*♦)  =SQRT  (X*X+Y*Y+Z*Z) 

C 

V (3)  =Z/V  (*♦) 

V (2)  *Y/V  (L) 

V(l)-X/V(*f) 

RETURN 

END 

SUBROUTINE  VECTR2  (V, XI ,YI ,ZI .XJ.YJ.ZJ, IERR) 

C 

C CALLED  BY  ? INP21 

C 

C 

c THIS  ROUTINE  FORMS  A UNIT  LENGTH  VECTOR  *V*  FROM  POINT  *1* 

C TO  POINT  *J*  IN  X.Y.Z  SPACE 

DIMENSION  V (3) 

IERR  = 1 

X * XJ  - XI 

V = YJ  - Yl 

Z = ZJ  - Zl 


C 
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XLN  =SQRT(X*X+Y*Y+Z*Z) 

IF  (XLN.LE.l .0E-08)  RETURN 
XLN  =1.0/  XLN 
I ERR  * 0 

V (3)  = Z * XLN 

V (2)  = Y * XLN 

V (1 ) = X * XLN 
RETURN 

END 


